home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d10 / ps1410.arc / CAL6.BAS < prev    next >
BASIC Source File  |  1990-10-31  |  93KB  |  2,340 lines
  1.     '=========================================================================
  2.     ' Personal Calendar (PC) Program
  3.     '  Copyright (c) 1985-1990, Paul Munoz-Colman.  All Rights Reserved.
  4.     '    Version 14.10
  5.     '     31 Oct 1990
  6.     '    Shareware $25
  7.     '=========================================================================
  8.     '              DOS File CAL6.BAS
  9.     '  Independently Compiled Subprograms Which Are Linked With CAL1.BAS
  10.     '=========================================================================
  11.     '  Written For IBM PCs & Compatibles Under MS DOS 3.30 on a Northgate 486
  12.     '   Compiled By Microsoft Professional BASIC 7.10, Linker Version 5.10
  13.     '=========================================================================
  14.     '  Note -- Tabs in the source file are in positions 6,11,16,21,26,...
  15.     '=========================================================================
  16.     ' $INCLUDE: 'cal1.bi'
  17.     '=========================================================================
  18.     '  Subprogram List in the Order of Appearance in this File
  19.     '   (compiled WITHOUT error handling--no /E or /X)
  20.     '-------------------------------------------------------------------------
  21.     '    Name                          Purpose
  22.     '    ---------------------------   ---------------------------------------
  23.     '    SetDateTime                   Change DOS Date and Time
  24.     '    SetOptions                    Write Options to Appointment File
  25.     '    SetVideoMode (Why)            Set User or Calendar Video Mode
  26.     '    SetVideoPage (Why)            Set Page Zero or User Page
  27.     '    ShowErase (Kolor,ScreenRow,ScreenColumn,EraseFirst,ShowString$)
  28.     '                                  Locate, Erase, and Display
  29.     '    ShowIt (Kolor,ScreenRow,ScreenColumn,ShowString$)
  30.     '                                  All Screen Displays
  31.     '    ShowMult (Kolor,ScreenMultRow,ScreenColumn,EraseFirst,
  32.     '         ScreenMultLines)         ShowErase for Multiple Lines
  33.     '    ShowOverduePage               Display Excess Overdue Events
  34.     '    Snooze (Secs!)                Sleep for Seconds
  35.     '    StayResInitialization        Stay Res Plus Startup Code
  36.     '    StayResKeyName                Get English Hot Key Name
  37.     '    StayResKeyShiftList           For a Shift Code, Get Scan List Pointer
  38.     '    StayResOptions (SrAutoOptions)  Stay-Res Plus Options Menu/Check
  39.     '    StayResPopDown (EntryPoint)   Pop Down
  40.     ' Fn    Strng$ (RptTimes%, FillChar%) Replacement for STRING$ (MhString)
  41.     '    Titles (NumberofLines)        Generate Screen Titles (1 to 4 Lines)
  42.     '    UnpackApptRecord              Unpack Event Record to Fields
  43.     '    UpdateClockScreen             Change Date & Time On Clock Screen
  44.     '    ValidateEventDate             Check if Date Is Good
  45.     '    VideoMonitorType              Check Mono or Color
  46.     '    WindowInit                    Initialize MhWind
  47.     '    WindowRestore                 Restore User or Program Screen
  48.     '    WindowSave                    Save User or Program Screen
  49.     '    WriteCalauto                  Write Auto Startup CALAUTO.DAT File
  50.     '    WriteCalDOS                   Write DOS Command CALDOS.DAT File
  51.     '    WriteCalexcl                  Write Exclusion CALEXCL.DAT File
  52.     '    WriteCalfig                   Write Color Choice CALFIG.DAT File
  53.     '    WriteCalmusic                 Write CALMUSIC.DAT File
  54.     '    WriteCalres                   Write CALRES.DAT File
  55.     '    WritetoHistory                Write Event to History (Check Exclusion)
  56.     '    YearAdjust (YeartoAdjust,AdjustedYear$)
  57.     '                                  Change Numeric Year To String Length 4
  58.     ' Fn ZeroFill$ (ToZeroFill$)       All Blanks to Zeroes in String
  59.     '=========================================================================
  60.     SUB SetDateTime STATIC
  61.     '=========================================================================
  62.     '   Set DOS Date and Time
  63.     DEFINT A-Z
  64.         SubnumSave = Subnum
  65.         Subnum = 116
  66.     '-------------------------------------------------------------------------
  67.     CALL ClearScreenNormal(N1)
  68.     CALL ShowErase(N7, N23, N62, N19, " Tab ")
  69.     CALL ShowIt(N6, N0, Nm1, "Previous Item ")
  70.     CALL ScreenBottoms
  71.     ScreenTitles$(N1) = "Change DOS Date and/or Time"
  72.     CALL Titles(N1)
  73.     CALL ShowIt(N6, N12, N1, _
  74. "Note:  Changing the DOS date and time will change your computer's")
  75.     CALL ShowIt(N0, Nm1, N0, _
  76. "       non-permanent CPU clock, and is effective until you reboot or")
  77.     CALL ShowIt(N0, Nm1, N0, _
  78. "       power off.")
  79.     CALL ShowIt(N0, N16, N0, _
  80. "       If your computer also has a permanent (battery-operated)")
  81.     CALL ShowIt(N0, Nm1, N0, _
  82. "       clock/calendar, it will be updated only if CPU clock changes are")
  83.     CALL ShowIt(N0, Nm1, N0, _
  84. "       monitored by your permanent clock's software or hardware.")
  85.     MessageColumn = 37
  86.     '-------------------------------------------------------------------------
  87.     FOR WhichType = N1 TO N2
  88.         '  1 is Date and 2 is Time
  89.         FOR WhichField = N1 TO N3
  90.             '---------------------------------------------------------------
  91.             '  Line 7 Date and 9 Time
  92. DateOrTime:
  93.                SELECT CASE WhichType
  94.                 CASE 1
  95.                     MessageText1$ = "Enter Date "
  96.                     BoxRow = N7
  97.                 CASE 2
  98.                     MessageText1$ = "Enter Time "
  99.                     BoxRow = N9
  100.             END SELECT
  101.             MessageRow = BoxRow
  102.             '---------------------------------------------------------------
  103.             BoxOffset = N3 * (WhichField - N1)        'Input Box Position
  104.             BoxColumn = N25 + BoxOffset
  105.             '---------------------------------------------------------------
  106.             SELECT CASE WhichType              ' Prompts and Field Lengths
  107.                 CASE 1
  108.                     DateTimeChange$ = DATE$
  109.                     SELECT CASE WhichField
  110.                         CASE 1
  111.                             MessageText2$ = "Day   "
  112.                             HoldAtEnd = N0
  113.                             Length = N2
  114.                         CASE 2
  115.                             MessageText2$ = "Month "
  116.                             Length = N2
  117.                         CASE 3
  118.                             MessageText2$ = "Year  "
  119.                             Length = N4
  120.                     END SELECT
  121.                 CASE 2
  122.                     DateTimeChange$ = TIME$
  123.                     SELECT CASE WhichField
  124.                         CASE 1
  125.                             MessageText2$ = "Hour  "
  126.                             Length = N2
  127.                         CASE 2
  128.                             MessageText2$ = "Minute"
  129.                             HoldAtEnd = N0
  130.                         CASE 3
  131.                             MessageText2$ = "Second"
  132.                             HoldAtEnd = N1
  133.                     END SELECT
  134.             END SELECT
  135.             CALL ShowIt(N7, BoxRow, N25, DateTimeChange$)  'Current Value
  136.             InputResponse$ = MID$(DateTimeChange$, N1 + BoxOffset, Length)
  137.             CALL ControlledInput(BoxRow, BoxColumn, MessageRow, _
  138.                 MessageColumn, Length, (MessageText1$ + MessageText2$), _
  139.                 InputResponse$, N1, N1, N1, HoldAtEnd)
  140.             ' Wants Out
  141.             CALL BlankError
  142.             IF RIGHT$(Keystroke$, N1) = CHR$(Esc) THEN GOTO DateTimeExit
  143.             IF RIGHT$(Keystroke$, N1) = CHR$(Tabb) THEN
  144.                 '  Previous Field on Tab Key
  145.                 WhichField = WhichField - N1
  146.                 IF WhichField = N0 THEN '  Previous Field Switches Types
  147.                     WhichField = N3
  148.                     GOSUB ClearSpace
  149.                     IF WhichType = N1 THEN 
  150.                         WhichType = N2 
  151.                       ELSE 
  152.                         WhichType = N1
  153.                     END IF
  154.                 END IF
  155.                 GOTO DateOrTime
  156.             END IF
  157.             '---------------------------------------------------------------
  158.             CALL Myd2(DateTimeChange$, N1 + BoxOffset, Length, _
  159.                 InputResponse$)
  160.             '---------------------------------------------------------------
  161.             '  Validate Date and Store if Good Date or Time
  162.             ErrorSwitch = No
  163.             CALL SetDateTimeGet (WhichType, DateTimeChange$)
  164.             IF ErrorSwitch THEN
  165.                 ErrorSwitch = No
  166.                 MessageText$ = MID$(MessageText1$, N7, N4) + _
  167.                     " Format or Range Is Unacceptable to DOS -- Try Again"
  168.                 CALL PrepareforMessage
  169.                 CALL ShowIt(N0, N0, N0, MessageText$)
  170.                 GOTO DateOrTime                     '  Try Again if Bad
  171.             END IF
  172.             '---------------------------------------------------------------
  173.         NEXT WhichField
  174.         '--------------------------------------------------------------------
  175.         GOSUB ClearSpace                    'Blank Out Prompt
  176.     NEXT WhichType
  177.     '-------------------------------------------------------------------------
  178.     '  Finished
  179. DateTimeExit:
  180.     CALL ClearScreenNormal(N1)
  181.     CALL DirectReturnCheck
  182.         Subnum = SubnumSave
  183.     EXIT SUB
  184.     '-------------------------------------------------------------------------
  185. ClearSpace:
  186.     CALL ShowIt(N0, BoxRow, MessageColumn, SPACE$(N16))
  187.     RETURN
  188.     END SUB
  189.     '=========================================================================
  190.     SUB SetOptions STATIC
  191.     '=========================================================================
  192.     '   Set Option Record From Individual Variables
  193.     DEFINT A-Z
  194.         SubnumSave = Subnum
  195.         Subnum = 77
  196.     '  Set Options
  197.     ApptMasterRec$ = Blank80$
  198.     CALL Myd2(ApptMasterRec$, N1, N8, ApptPassword$)
  199.     '  Pos 1-8 Password
  200.     CALL Myd2(ApptMasterRec$, N9, N1, (RIGHT$(STR$(FooterSize), N1)))
  201.     '  Pos  9 Footer Size
  202.     CALL Myd2(ApptMasterRec$, N10, N1, (RIGHT$(STR$(SoundLevel), N1)))
  203.     '  Pos 10 Alarm Initial Condition
  204.     CALL Myd2(ApptMasterRec$, N11, N1, (RIGHT$(STR$(NoteSize), N1)))
  205.     '  Pos 11 Size Of Note Area On Footer
  206.     IF InclHistory THEN IncludeHistory$ = True$ ELSE IncludeHistory$ = False$
  207.     CALL Myd2(ApptMasterRec$, N13, N1, IncludeHistory$)
  208.     '  Pos 13  Print,Copy History
  209.     IF InclNotes THEN IncludeNotes$ = True$ ELSE IncludeNotes$ = False$
  210.     CALL Myd2(ApptMasterRec$, N14, N1, IncludeNotes$)
  211.     '  Pos 14  Print,Copy Notes
  212.     CALL Myd2(ApptMasterRec$, N15, N1, WeekendScheduling$)
  213.     '  Pos 15  Allow Weekends On Daily
  214.     CALL Myd2(ApptMasterRec$, N16, N1, EventSizeCode$)
  215.     '  Pos 16  60 Events "e"
  216.     CALL Myd2(ApptMasterRec$, N17, N2, (RIGHT$(STR$(Pending), N2)))
  217.     '  Pos 17-18  Event Look-Ahead in Minutes
  218.     CALL Myd2(ApptMasterRec$, N19, N1, SelectedPrinter$)
  219.     '  Pos 19  Selected Printer Code or "-" for disable
  220.     CALL Myd2(ApptMasterRec$, N20, N1, WeekBreak$)
  221.     '  Pos 20  Week Break on ASCII File or Print
  222.     CALL Myd2(ApptMasterRec$, N21, N1, NoteSizeCode$)
  223.     '  Pos 21  60 Notes "e"
  224.     CALL Myd2(ApptMasterRec$, N22, N2, (RIGHT$(STR$(PrinterLineLimit), N2)))
  225.     '  Pos 22-23  Printer Line Limit for Paging (0 means no paging)
  226.     CALL Myd2(ApptMasterRec$, N24, N1, PrinterPause$)
  227.     '  Pos 24  PrinterPause$
  228.     DO                                      ' No Hex 0's in Master Record!
  229.         J = InString(ApptMasterRec$, CHR$(N0))
  230.         IF J THEN CALL Myd2(ApptMasterRec$, J, N1, Blank1$)
  231.     LOOP UNTIL J = N0
  232.     CALL MhLset(ApptBuffer$, ApptMasterRec$)
  233.     CALL PutApptRecord(N1)
  234.         Subnum = SubnumSave
  235.     END SUB
  236.     '=========================================================================
  237.     SUB SetVideoMode (Why)  STATIC
  238.     '=========================================================================
  239.     DEFINT A-Z
  240.         SubnumSave = Subnum
  241.         Subnum = 51
  242.     IF Why THEN                ' Determine whether calendar or user mode
  243.         AL% = UserMode            '    Set user program mode
  244.       ELSE
  245.         IF UserMode = N2 THEN        '    Set calendar mode unless user
  246.             CalMode = N2
  247.           ELSEIF ColorCRT THEN
  248.             CalMode = N3
  249.           ELSE
  250.             CalMode = N7
  251.         END IF
  252.         AL% = CalMode            '    mode is 2
  253.     END IF
  254.     '  Note that even though the current video mode is saved here, coming
  255.     '   back from DOS can change the value of CurrentVideoMode, which is
  256.     '   also tested and set in SaveDOSKeyState
  257.     IF AL% <> CurrentVideoMode THEN    ' If the requested mode is different
  258.         CALL SrSetVideoMode(AL%)        '  change it using Stay-Res
  259.         CurrentVideoMode = AL%        '  and save the result
  260.     END IF
  261.     IF Why THEN                    ' Change lines per screen
  262.         IF UserColumns = N80 THEN    ' If user display had 80 columns
  263.             SELECT CASE UserRows    '  see if 43 or 50 line mode indicated
  264.                 CASE N25            ' 25-line mode
  265.                     IF DisplayRows <> N25 OR DisplayColumns <> N80 THEN
  266.                         CALL Mh80x25
  267.                         DisplayRows = N25
  268.                     END IF    
  269.                 CASE N43            ' 43-line (EGA) mode
  270.                     IF DisplayRows <> N43 OR DisplayColumns <> N80 THEN
  271.                         CALL Mh80x43(Ecode43%)
  272.                         IF Ecode43 = N0 THEN DisplayRows = N43
  273.                     END IF
  274.                 CASE N50            ' 50-line (VGA) mode
  275.                     IF DisplayRows <> N50 OR DisplayColumns <> N80 THEN
  276.                         CALL Mh80x50(Ecode50%)
  277.                         IF Ecode50 = 0 THEN DisplayRows = 50
  278.                     END IF
  279.             END SELECT
  280.         END IF
  281.       ELSE
  282.         ' Restore screen lines if necessary
  283.         IF DisplayRows <> N25 OR DisplayColumns <> N80 THEN
  284.             CALL Mh80x25
  285.             DisplayRows = N25
  286.             DisplayColumns = N80
  287.         END IF
  288.     END IF
  289.         Subnum = SubnumSave
  290.     END SUB
  291.     '=========================================================================
  292.     SUB SetVideoPage (Why)  STATIC
  293.     '=========================================================================
  294.     DEFINT A-Z
  295.         SubnumSave = Subnum
  296.         Subnum = 137
  297.     InterruptNumber% = &H10            ' ROM-BIOS Video Services Interrupt
  298.     AH% = &H05                    ' Set Video Page
  299.     IF Why THEN
  300.         AL% = DOSCursorPage
  301.       ELSE
  302.         AL% = ScreenPage
  303.     END IF
  304.     IF AL% <> CurrentVideoPage THEN
  305.         CurrentVideoPage = AL%
  306.         CALL DOSBIOSServices
  307.     END IF
  308.         Subnum = SubnumSave
  309.     END SUB
  310.     '=========================================================================
  311.     SUB ShowErase (EKolor, EScreenRow, EScreenColumn, _
  312.         EraseFirst, ShowString$) STATIC
  313.     '=========================================================================
  314.     DEFINT A-Z
  315.         SubnumSave = Subnum
  316.         Subnum = 78
  317.     ScreenColumn = EScreenColumn
  318.     ScreenRow = EScreenRow
  319.     Kolor = EKolor
  320.     CALL ShowIt(Kolor, ScreenRow, ScreenColumn, (SPACE$(EraseFirst)))
  321.     CALL ShowIt(Kolor, ScreenRow, ScreenColumn, ShowString$)
  322.         Subnum = SubnumSave
  323.     END SUB
  324.     '=========================================================================
  325.     SUB ShowIt (IKolor, ShowRow, ShowColumn, ShowString$) STATIC
  326.     '=========================================================================
  327.     '   Single Place to Call MhScr to Display Stuff On Screen (easier call)
  328.     DEFINT A-Z
  329.         SubnumSave = Subnum
  330.         Subnum = 79
  331.     '  Use pre-existing screenrow and screencolumn if input is zero
  332.     '    ScreenPage and ColorAttribute already set and in Common
  333.     '    Kolor non zero means change color requested
  334.     Kolor = IKolor
  335.     IF Kolor THEN CALL Kolors(Kolor)   ' Set Color if Asked For
  336.     SELECT CASE ShowRow
  337.         CASE IS < N0                   ' Increment n rows, Same Column
  338.             ScreenRow = ScreenRow + ABS(ShowRow)
  339.         CASE 0                        ' Screen Row Remains Unchanged
  340.         CASE ELSE                     ' Screen Row Is Input Value
  341.             ScreenRow = ShowRow
  342.     END SELECT
  343.     SELECT CASE ShowColumn
  344.         CASE Nm2                       ' Line Automatically Centered L-to-R
  345.             ToCenter = LEN(ShowString$)
  346.             IF ToCenter MOD 2 = 1 THEN
  347.                 ToCenter = ToCenter + 1
  348.             END IF
  349.             ScreenColumn = (N80 - ToCenter) \ N2
  350.         CASE Nm1                       ' Screen Column Bumped By Previous
  351.             ScreenColumn = ScreenColumn + PreviousLength
  352.         CASE 0                        ' Screen Column Remains Unchanged
  353.         CASE ELSE                     ' Screen Column Is Input Value
  354.             ScreenColumn = ShowColumn
  355.     END SELECT
  356.     CALL MhScr(ShowString$, ScreenPage%, ScreenRow%, ScreenColumn%, _
  357.         ColorAttribute%)
  358.     PreviousLength = LEN(ShowString$)  ' Save Length for Future -1 Call
  359.         Subnum = SubnumSave
  360.     END SUB
  361.     '=========================================================================
  362.     SUB ShowMult (MKolor, ScreenMultRow, MScreenColumn, EraseFirst, _
  363.         ScreenMultLines) STATIC
  364.     '=========================================================================
  365.     '  ShowErase for Multiple Lines
  366.     '  Starting Row,Column,EraseFirst,Number of Lines
  367.     DEFINT A-Z
  368.         SubnumSave = Subnum
  369.         Subnum = 80
  370.     Kolor = MKolor
  371.     ScreenColumn = MScreenColumn
  372.     FOR ZJ = N1 TO ScreenMultLines
  373.         AtRow = ScreenMultRow + ZJ - N1
  374.         AtColumn = ScreenColumn
  375.         AtErase = EraseFirst
  376.         CALL ShowErase(Kolor, AtRow, AtColumn, AtErase, Blank0$)
  377.     NEXT ZJ
  378.     ScreenRow = ScreenMultRow
  379.         Subnum = SubnumSave
  380.     END SUB
  381.     '=========================================================================
  382.     SUB ShowOverduePage STATIC
  383.     '=========================================================================
  384.     DEFINT A-Z
  385.         SubnumSave = Subnum
  386.         Subnum = 81
  387.     CALL ClearScreenNormal(N0)
  388.     OnOverduePage = Yes
  389.     IF SoundLevel > N2 THEN CALL PlayAlarmWarning(N0)
  390.     ScreenSize = N20
  391.     ClockScreen = No
  392.     OnEditPage = No
  393.     IF NOT FileExist(ApptFilenameOverdue$) THEN ' If called erroneously, exit
  394.         OverdueCount = N0
  395.         GOTO ExitPoint0
  396.     END IF
  397.     OPEN "R", FilenumOverdue, ApptFilenameOverdue$, N80
  398.     FIELD FilenumOverdue, N80 AS OverdueBuffer$
  399.     LastRecord = LOF(FilenumOverdue) \ N80           'Last Record Number
  400.     LastPage = N1 + ((LastRecord - N1) \ ScreenSize)'Last Page
  401.     CurrentPage = N1
  402.     '  Start New Page
  403. NewOverduePage:
  404.     CALL ClearScreenNormal(N0)
  405.     CALL KeyStuff(KeyStatusAbs)
  406.     CurrentRecord = N1 + (CurrentPage - N1) * ScreenSize
  407.     '---------------------------------------------------------------
  408.     '  Refresh Headers and Trailers
  409.     ScreenTitles$(N1) = STR$(OverdueCount) + " EVENTS ARE OVERDUE!"
  410.     CALL Titles(N1)
  411.     CALL PopLine
  412.     CALL QuitLine
  413.     IF CurrentRecord > ScreenSize THEN
  414.         CALL ShowIt(N7, N24, N1, "PgUp")
  415.         CALL ShowIt(N6, N0, Nm1, " Previous Page")
  416.         CALL ShowIt(N7, N0, N27, "Home")
  417.         CALL ShowIt(N6, N0, Nm1, " 1st Page")
  418.     END IF
  419.     IF CurrentPage < LastPage THEN
  420.         CALL ShowIt(N7, N25, N1, "PgDn")
  421.         CALL ShowIt(N6, N0, Nm1, " Next Page")
  422.         CALL ShowIt(N7, N0, N27, "End")
  423.         CALL ShowIt(N6, N0, Nm1, " Last Page")
  424.     END IF
  425.     CALL ShowIt(N7, N25, N43, " Return,Esc ")
  426.     CALL ShowIt(N6, N0, Nm1, "Clock")
  427.     '  Get Next Record
  428. GetOverdueRecord:
  429.     GET FilenumOverdue, CurrentRecord
  430.     '  Set Screen Position
  431.     ScreenPosition = N3 + (CurrentRecord - N1) MOD ScreenSize
  432.     CALL ShowIt(N0, ScreenPosition, N1, OverdueBuffer$)
  433.     '  End File  or  End Page
  434.     IF CurrentRecord < LastRecord AND _
  435.       (CurrentRecord MOD ScreenSize) <> N0 THEN
  436.         CurrentRecord = CurrentRecord + N1
  437.         GOTO GetOverdueRecord
  438.     END IF
  439. NextOverdueKey:
  440.     CALL KeyStuff(KeyWait)             ' Wait for a keystroke
  441.     SELECT CASE LEN(Keystroke$)
  442.         CASE 1                        '  Length 1 Keys (Esc,Prnt)
  443.             SELECT CASE InString(CHR$(Enter) + CHR$(Esc), Keystroke$)
  444.                 CASE 1,2         '  Enter or Esc
  445.                     '  Resume Clock Exit
  446.                     RedisplayCalendars = Yes
  447.                     CALL ClearOverdueTable
  448.                 CASE ELSE     'Other Length 1 Keys (also Length 2)
  449.                     GOTO BadOverdueKey
  450.             END SELECT
  451.             GOTO ExitPoint0
  452.         CASE 2                        '  Length 2 Keys
  453.         '  Length 2 keys -- Next,Prev,First,Last,SpecificPage
  454.         SELECT CASE InString(CHR$(PgUp) + CHR$(PgDn) + CHR$(HomeKey) + _
  455.                        CHR$(EndKey), RIGHT$(Keystroke$, N1))
  456.             CASE 1, 3                '  PgUp or Home
  457.                 IF CurrentPage <= N1 THEN GOTO BadOverdueKey
  458.                 '  Pg Up or Home
  459.                 IF RIGHT$(Keystroke$, N1) = CHR$(PgUp) THEN
  460.                     CurrentPage = CurrentPage - N1      'PgUp
  461.                   ELSE
  462.                     CurrentPage = N1                    'Home
  463.                 END IF
  464.                 GOTO NewOverduePage
  465.             CASE 2, N4                '  PgDn or End
  466.                 IF CurrentPage >= LastPage THEN GOTO BadOverdueKey
  467.                 IF RIGHT$(Keystroke$, N1) = CHR$(PgDn) THEN
  468.                     CurrentPage = CurrentPage + N1      'PgDn
  469.                   ELSE
  470.                     CurrentPage = LastPage             'End
  471.                 END IF
  472.                 GOTO NewOverduePage
  473.             CASE ELSE
  474. BadOverdueKey:
  475.                 CALL MinorBeeper
  476.                 GOTO NextOverdueKey
  477.         END SELECT
  478.     END SELECT
  479. ExitPoint0:
  480.     OnOverduePage = No
  481.         Subnum = SubnumSave
  482.     END SUB
  483.     '=========================================================================
  484.     SUB Snooze (Secs!)  STATIC
  485.     '=========================================================================
  486.     DEFINT A-Z
  487.         SubnumSave = Subnum
  488.         Subnum = 62
  489.     SnoozeSave! = TIMER                            ' Save Timer Value
  490.     DO                                        ' Loop 
  491.         IF NOT HardSnooze THEN 
  492.             CALL KeyStuff(KeySingle)   ' May interrupt
  493.         END IF
  494.         SnoozeOver! = TIMER                            ' Save Current Timer
  495.         IF SnoozeOver! < SnoozeSave! THEN                ' Over Midnight?
  496.             SnoozeSave! = SnoozeSave! - 86400!            ' Yes-adjust
  497.         END IF                                    '  by one day
  498.         IF (SnoozeOver! - SnoozeSave!) > Secs! OR _    ' Until Keypress or
  499.            LEN(Keystroke$) THEN                    ' If not done
  500.             EXIT DO
  501.         END IF
  502.     LOOP
  503. ExitPoint:
  504.         Subnum = SubnumSave                        ' Else Exit
  505.     END SUB
  506.     '=========================================================================
  507.     'Stay-Res Plus 4.00 Order of CALL Precedence --
  508.     '--------------------------------------------------------------------
  509.     'The following BASIC code shows the order in which calls should (and
  510.     'should not) be made to Stay-Res Plus routines. Note that it is not
  511.     'necessary to CALL all the routines shown.
  512.     '--------------------------------------------------------------------
  513.     'The following routines can be CALLed at any time
  514.     '--------------------------------------------------------------------
  515.     'CALL SrAutoScreenSave (Filename$, Ecode%)
  516.     'CALL SrDontRestoreScreen
  517.     'CALL SrDoRestoreGInfo
  518.     'CALL SrGetPokeAddress(Dtaseg%, Offset%)
  519.     'CALL SrMousePopUp(MButton%, MTopRow%, MLeftCol%, MBotRow%, MRightCol%)
  520.     'CALLS SrMultiKeys(ScanCode%(x), ShiftStatus%(x), HowManyKeys%)
  521.     'CALL SrNoSnow
  522.     'CALL SrResetHotkey(Kscan%, Kshift%)
  523.     'CALL SrSetBusyWait(Ticks%)
  524.     'CALL SrSetCom(Port%, Ecode%)
  525.     'CALL SrSetInt5
  526.     'CALL SrSetKBIdleTicks(Ticks%)
  527.     'CALL SrSetPokeChar(Ascii%)
  528.     'CALL SrSetQBPopUp
  529.     'CALL SrSetTimeY(Month%, Day%, Year%, Hour%, Minute%)
  530.     'CALL SrSetVideoMode(Mode%)
  531.     'CALL SrSoundOnBreak
  532.     'CALL SrTickPopUp(Ticks%)
  533.     'CALL SrUseAnyKey
  534.     'CALL SrUseComStatus(Port%, PortAddress%, TickDelay%, StatusMask%, Ecode%)
  535.     'CALL SrUseCtrlAltDel
  536.     'CALL SrUseErrorTable
  537.     'CALL SrUseSysReq
  538.     'CALL SrWaitAfter255
  539.     '--------------------------------------------------------------------
  540.     'The following routines must be CALLed prior to CALLing any of
  541.     '    SrCheckEms, SrSetDiskSwap and SrPopDown.
  542.     '--------------------------------------------------------------------
  543.     'CALL SrCancelForceFile0
  544.     'CALL SrForceFile0
  545.     'CALL SrSetDosMem(Bytes&)
  546.     'CALL SrSetUserMem(Bytes&)
  547.     '--------------------------------------------------------------------
  548.     'The following routines can be CALLed anytime before CALLing SrPopDown
  549.     'the first time
  550.     '--------------------------------------------------------------------
  551.     'CALL SrSetId(IDName$, IDNumber%, Ecode%)
  552.     'CALL SrUnInstall(Ecode%)
  553.     'CALL SrUseInterrupt (PopUpInterrupt%, ProcessInterrupt%, Ecode%)
  554.     '--------------------------------------------------------------------
  555.     'The following routines should be CALLed only after CALLing the
  556.     'counterpart routines. However, they can be CALLed before or after
  557.     'becoming memory-resident.
  558.     '--------------------------------------------------------------------
  559.     'CALL SrCancelAutoScreenSave
  560.     'CALL SrCancelQBPopUp
  561.     'CALL SrCancelUseAnyKey
  562.     'CALL SrCancelUseCtrlAltDel
  563.     'CALL SrCancelUseInterrupt
  564.     'CALL SrCancelUseSysReq
  565.     'CALL SrCancelWaitAfter255
  566.     'CALL SrDoRestoreScreen
  567.     'CALL SrDontRestoreGInfo
  568.     'CALL SrReleaseInt5
  569.     'CALL SrReleaseTimeY
  570.     '--------------------------------------------------------------------
  571.     'The following routines should be CALLed immediately before CALLing
  572.     'SrPopDown the first time
  573.     '--------------------------------------------------------------------
  574.     'CALL SrCheckEMS(Ecode%)
  575.     'CALL SrSetDiskSwap(FileName$, Ecode%)
  576.     '--------------------------------------------------------------------
  577.     'This is where you CALL SrPopDown
  578.     '--------------------------------------------------------------------
  579.     'CALL SrPopDown(Kscan%, Kshift%, Ecode%)
  580.     '--------------------------------------------------------------------
  581.     'CALLing the following routines is meaningful only after your program
  582.     'has become memory-resident and has successfully popped up
  583.     '--------------------------------------------------------------------
  584.     'CALL SrCancelMacro
  585.     'CALL SrCancelShell
  586.     'CALL SrFetchAnyKey(AAscii%, AScan%, Shift1%, Shift2%)
  587.     'CALL SrFetchRegisters(UserType)
  588.     'CALL SrGetCursorInfo(Page%, Row%, Column%, StartLine%, EndLine%)
  589.     'CALL SrGetEnvironment(Dtaseg%)
  590.     'CALL SrGetErrorLevel(Elevel%)
  591.     'Result$ = SrGetProgramName$
  592.     'Result% = SrOverDos%
  593.     'Result% = SrScreenSaved%
  594.     'CALL SrReleaseMem(Ecode%)
  595.     'CALL SrResidentBatch(CmndLine$, Ecode%)
  596.     'CALL SrResidentShell(CmndLine$, Ecode%)
  597.     'CALL SrRestoreScreen
  598.     'CALL SrSetMacro(Macro$, Shift$)
  599.     'CALL SrSetRegisters(UserType)
  600.     '=========================================================================
  601.     SUB StayResInitialization (EntryPoint)  STATIC
  602.     '=========================================================================
  603.     DEFINT A-Z
  604.         SubnumSave = Subnum
  605.         Subnum = 118
  606.     '=========================================================================
  607.     '  This initialization code is executed only once, at the beginning 
  608.     '   of program initialization.  See MainSub at the beginning for the
  609.     '   calls to these entry points.
  610.     '=========================================================================
  611.     SELECT CASE EntryPoint
  612.         '--------------------------------------------------------------------
  613.         CASE 0
  614.             '-----------------------------------------------------------
  615.             '  Check/set Program's ID.  If There, Exit
  616.             SrMhIDName$ = "CAL"    ' Stay-Res ID Name for This Program
  617.             ' MicroHelp-Assigned Stay-Res ID Number For This Program
  618.             SrMhIDNumber% = 1006
  619.             CALL SrSetId(SrMhIDName$, SrMhIDNumber%, Ecode%)
  620.             '-----------------------------------------------------------
  621.             IF Ecode% THEN
  622.                 ' Program already in memory. Pop up old copy and terminate.
  623.                 '  This pops up on ASCII 254
  624.                 IF NOT FileExist("calpopup.com") THEN      'If no calpopup
  625.                     OPEN "R", #N1, "calpopup.com", N12      'file, then create
  626.                     FIELD #N1, N12 AS CalPopupString$      'one 12-byte rec
  627.                     LSET CalPopupString$ = "3└Ä╪╕■■ú═ "'using same con-
  628.                     PUT #N1, N1                      'tents of original
  629.                     CLOSE #N1                          'file
  630.                 END IF            ' (if SRPOKER.COM Changes, this changes)
  631.                 RUN "calpopup.com"             'and pop up old copy
  632.                 '===================================================
  633.                 ' Program Terminates Here To Pop Up In-Memory Copy !
  634.                 '===================================================
  635.             END IF
  636.             '-----------------------------------------------------------
  637.             DIM WindowBuffer(2004)        'DIM Dynamic MhWind Buffer Array
  638.             '-----------------------------------------------------------
  639.         CASE 1
  640.             '-----------------------------------------------------------
  641.             '    Set Stay-Res Plus Options
  642.             '  to defaults, overridden by CALRES.DAT file
  643.             '-----------------------------------------------------------
  644.             UseEMS$ = True$            ' Allow EMS Usage (default)
  645.             UseDiskSwap$ = True$        ' Allow Disk Swapping
  646.             '-----------------------------------------------------------
  647.             CALL ReadCalres          
  648.             '-----------------------------------------------------------
  649.             ' File CALRES.DAT is read at this point, which sets
  650.             'AllowPopDateTime            ' Whether date/time popup allowed
  651.              'EverResident$                ' Whether user ever used TSR mode
  652.              'SrAutoPopDown                ' Whether auto pop down allowed
  653.             'SrDiskSwapping            ' Whether disk swapping allowed
  654.             'SrDontUseEMS                ' Whether EMS use not allowed
  655.             'SrKscanHot                ' Hot key scan code
  656.             'SrKshiftHot                ' Hot key shift code
  657.             'SrOptionsChosen            ' Whether opts menu needs calling
  658.             'SrSnowCheck                ' Whether CGA snow checking needed
  659.             'SrSwapPath$                ' Disk swap/screen save drive/path
  660.             'SrHotKeyName$                ' English name of hot key
  661.             'UseDiskSwap$                ' Whether disk swapping allowed
  662.              'UseEMS$                    ' Whether EMS swapping allowed
  663.             'UserPopDateTime$            ' Whether date/time popup allowed
  664.             '-----------------------------------------------------------
  665.             SrAutoPopDownReady = No        ' Auto pop down not ready
  666.             SrAutoPopDownHappened = No    ' Auto pop down hasn't happened
  667.             SrDiskSwapped = No          ' Set Disk Swapping Not Occurred
  668.             SrEMS = No                  ' Initialize EMS Available Flag
  669.             SrPopDateTime = No          ' Disable Pop Up on Date/Time
  670.             SrSetUserMemCalled = No        ' SETMEM hasn't been called
  671.             '-----------------------------------------------------------
  672.             ' Delete old swap files if they are there
  673.             '  Establish path followed by "\" for later use
  674.             IF RIGHT$(SrSwapPath$, N1) <> "\" THEN
  675.                 SrSwapPathAdjusted$ = SrSwapPath$ + "\"
  676.               ELSE
  677.                 SrSwapPathAdjusted$ = SrSwapPath$
  678.             END IF
  679.             CALL KillAFile(SrSwapPathAdjusted$ + "calswap.000")
  680.             CALL KillAFile(SrSwapPathAdjusted$ + "calswap.001")
  681.             '-----------------------------------------------------------
  682.             ' Delete old screen files and establish pointer to new one
  683.             EgaFilename$ = "CALSCRN.DAT"  ' Screen Save File Name (ASCIIN)
  684.             EgaFilename2$ = ASCIIZ$(EgaFilename$)  '              (ASCIIZ)
  685.             EgaFilePath$ = SrSwapPathAdjusted$ + EgaFilename$
  686.             EgaFilePath2$ = ASCIIZ$(EgaFilePath$)
  687.             CALL KillAFile(EgaFilename$)    ' Kill Screen File if There
  688.             '-----------------------------------------------------------
  689.             CALL SrSetCom(N0, Ecode%)     'No comm pop up
  690.             SrPokeCharCode% = 254        ' Wake up on dual 254's
  691.             CALL SrSetPokeChar(SrPokeCharCode%)
  692.             CALL SrUseErrorTable        'Extended DOS Busy Error Codes
  693.             '-----------------------------------------------------------
  694.     END SELECT
  695.         Subnum = SubnumSave
  696.     END SUB
  697.     '=========================================================================
  698.     SUB StayResKeyName STATIC
  699.     '=========================================================================
  700.     '  Get Hot Key Name and Set List Switches
  701.     '   Input is SrKshiftHot and SrKscanHot
  702.     '   Output is Scan Code List Pointer, English Name
  703.     '          (SrScanChoice)         (SrHotKeyName$)
  704.     DEFINT A-Z
  705.         SubnumSave = Subnum
  706.         Subnum = 82
  707.     CALL StayResKeyShiftList      ' Get Scan Code List Pointer
  708.     IF SrKscanHot THEN
  709.         FOR I = N1 TO NumberofHotFKeys
  710.             IF FunctionScanCodes(SrWhichFList, I) = SrKscanHot THEN
  711.                 SrScanChoice = I
  712.                 EXIT FOR
  713.             END IF
  714.         NEXT I
  715.       ELSE
  716.         SrScanChoice = N0
  717.     END IF
  718.     ' Don't use Control Key Names unless using some of the keys(!)
  719.     SrHotKeyName$ = Blank0$
  720.     IF SrKshiftHot THEN SrHotKeyName$ = HotKeyNames$(SrKshiftHot + N1)
  721.     IF SrKshiftHot > N0 AND SrScanChoice > N0 THEN
  722.         SrHotKeyName$ = SrHotKeyName$ + " and "
  723.     END IF
  724.     IF SrScanChoice > N0 THEN
  725.         SrHotKeyName$ = SrHotKeyName$ + "F" + LTRIM$(STR$(SrScanChoice))
  726.     END IF
  727.         Subnum = SubnumSave
  728.     END SUB
  729.     '=========================================================================
  730.     SUB StayResKeyShiftList STATIC
  731.     '=========================================================================
  732.     '  Get Which Shift List a Shift Key Is In
  733.     '   Input is Shift Code (SrKshiftHot), Output is Which List (SrWhichFList)
  734.     DEFINT A-Z
  735.         SubnumSave = Subnum
  736.         Subnum = 83
  737.     SELECT CASE SrKshiftHot
  738.         CASE 0              ' Not Shift/Ctrl/Alt
  739.             SrWhichFList = N1
  740.         CASE 1 TO 3         ' Either Shift
  741.             SrWhichFList = N2
  742.         CASE N4 TO 7         ' Ctrl (& Shift)
  743.             SrWhichFList = N3
  744.         CASE N8 TO N15        ' Alt (& Ctrl & Shift)
  745.             SrWhichFList = N4
  746.     END SELECT
  747.         Subnum = SubnumSave
  748.     END SUB
  749.     '=========================================================================
  750.     SUB StayResOptions (OSrAutoOptions) STATIC
  751.     '=========================================================================
  752.     '  Set Memory Resident Options From File or From Menu
  753.     DEFINT A-Z
  754.         SubnumSave = Subnum
  755.         Subnum = 84
  756.     SrAutoOptions = OSrAutoOptions
  757.     NoKeyChoice = No
  758.     SnowReset = No
  759.     IF SrAutoOptions THEN                   ' If called on 1st pop down then
  760.         NewGuyHold = NewGuy                '  save all return switches
  761.         NewGuy = Yes                       '  and set them accordingly
  762.         StartupScreenHold = StartupScreen  '  to avoid reflexive popping
  763.         StartupScreen = No                 '  problems.  (This is called
  764.         ClockScreenHold = ClockScreen      '  from StayResPopDown which is
  765.         OnEditPageHold = OnEditPage        '  called from KeyStuff.  KeyStuff
  766.         ClockScreen = No                   '  is also used by the routines
  767.         OnEditPage = No                    '  this sub uses, which could
  768.         InHelpHold = InHelp                '  get into a deadly embrace.
  769.         InHelp = No
  770.         TimerDisplaySuppressHold = TimerDisplaySuppress
  771.         CursorStateHold = CursorState
  772.         CursorState = N0
  773.     END IF
  774.     ValidSwapPath$ = SrSwapPath$       ' Save In Case User Messes It Up
  775.     '--------------------------------------------------------------------
  776.     ' Options Haven't Been Set or Menu was Called to Set Them
  777. MemResOptionsMenu:
  778.     CALL ClearScreenNormal(N1)
  779.     ScreenTitles$(N1) = "Memory-Resident (TSR Mode) Options"
  780.     ScreenTitles$(N2) = "(Please Consult Help Text For Explanation)"
  781.     CALL Titles(Nm2)
  782.     IF NOT SrOptionsChosen THEN
  783.         SrOptionsChosen = Yes
  784.         EverResident$ = True$
  785.         CALL PrepareforMessage
  786.         CALL MajorBeeper
  787.         CALL ShowIt(N0, N0, N0, _
  788.      "PC Has Never Been in TSR Mode in this Directory--Options Are As Follows")
  789.       ELSEIF SnowReset THEN
  790.         SnowReset = No
  791.         CALL PrepareforMessage
  792.         CALL ShowIt(N0, N0, N0, _
  793.       "Disk Swap/Screen Save File Path is Longer than 65 Bytes--Try Again")
  794.     END IF
  795.     CALL StayResKeyName
  796.     MenuLines(N1) = "Hot Key for Pop Up, Currently " + SrHotKeyName$
  797.     IF AllowPopDateTime OR AllowPopDateTimeSave THEN
  798.         ScreenTag$ = Yess$
  799.       ELSE
  800.         ScreenTag$ = Noo$
  801.     END IF
  802.     MenuLines(N2) = "Automatic Pop Up on Date/Time, Currently " + ScreenTag$
  803.     IF SrAutoPopDown THEN ScreenTag$ = Yess$ ELSE ScreenTag$ = Noo$
  804.     MenuLines(N3) = _
  805.         "Automatic Pop Down after Automatic Startup, Currently " + ScreenTag$
  806.     IF UseEMS$ = True$ THEN ScreenTag$ = Yess$ ELSE ScreenTag$ = Noo$
  807.     MenuLines(N4) = "Expanded (EMS) Memory for Program & Screens When " + _
  808.         "Popped Down, Currently " + ScreenTag$
  809.     IF UseDiskSwap$ = True$ THEN ScreenTag$ = Yess$ ELSE ScreenTag$ = Noo$
  810.     MenuLines(N5) = _
  811. "Disk Swapping for Program & Screens When Popped Down, Currently " + ScreenTag$
  812.     MenuLines(N6) = "Disk Swap To " + SrSwapPath$
  813.     IF SrSnowCheck = Yes THEN ScreenTag$ = Yess$ ELSE ScreenTag$ = Noo$
  814.     MenuLines(N7) = _
  815.         "Snow Checking State for CGA Monitors, Currently " + ScreenTag$
  816.     IF SrPopupOnlyIfScreenSaved THEN ScreenTag$ = Noo$ ELSE ScreenTag$ = Yess$
  817.     MenuLines(N8) = _
  818.   "Avoid Pop Up if Unable to Save Non-Standard Video Screen, Currently " + _
  819.         ScreenTag$
  820.     '--------------------------------------------------------------------
  821.     '  Options Menu Choice
  822.     CALL ShowIt(N6, N19, N1, _
  823. ("- Hot Key, Automatic Pop Up/Pop Down, Snow Check " + _
  824.         "Changes Take Effect Immediately"))
  825.     CALL ShowIt(N0, Nm1, N0, _
  826. "- If EMS Memory and Disk Swapping Are Both Chosen, EMS Is Attempted First")
  827.     CALL ShowIt(N0, Nm1, N0, _
  828. ("- Disk Swapping/Screen Save Can Be Used With" + _
  829.         " A Virtual Disk (RAMDISK or VDISK)"))
  830.     IF MemoryResident THEN
  831.         CALL ShowIt(N0, Nm1, N0, _
  832. "- Disk or EMS Swapping Changes Are Not In Effect Until PC is Restarted")
  833.     END IF
  834.     MenuSize = N8
  835.     MenuRow = N6
  836.     CALL WriteCalres                        ' Save the Results 1st!
  837.     CALL MenuDriver(MenuSize, MenuSrOpt, MenuRow, Nm1, No, N0, N1, N1)
  838.     IF MenuExit = MenuCancelled THEN
  839.         IF NOT SrAutoOptions THEN                    ' If from menu, return
  840.             CALL ClearScreenNormal(N1)
  841.             CALL DirectReturnCheck
  842.           ELSE
  843.             InHelp = InHelpHold
  844.             StartupScreen = StartupScreenHold
  845.             ClockScreen = ClockScreenHold
  846.             OnEditPage = OnEditPageHold
  847.             NewGuy = NewGuyHold
  848.             SrAutoOptions = No
  849.             TimerDisplaySuppress = TimerDisplaySuppressHold
  850.             CursorState = CursorStateHold
  851.         END IF
  852.         GOTO ExitPoint2
  853.     END IF
  854.     SELECT CASE MenuSrOpt
  855.         CASE 1                                  ' Hot Key Change
  856.             GOSUB NewHotKey
  857.         CASE 2                                  ' Pop Date/Time Change
  858.             IF AllowPopDateTime OR AllowPopDateTimeSave THEN
  859.                 AllowPopDateTime = No
  860.                 AllowPopDateTimeSave = No
  861.                 UserPopDateTime$ = False$
  862.               ELSE
  863.                 AllowPopDateTime = Yes
  864.                 UserPopDateTime$ = True$
  865.             END IF
  866.         CASE 3                                  ' Auto Pop Down Change
  867.             IF SrAutoPopDown THEN
  868.                 SrAutoPopDown = No
  869.               ELSE
  870.                 SrAutoPopDown = Yes                ' don't let this change
  871.                 SrAutoPopDownHappened = Yes        ' do an auto-pop down!
  872.             END IF
  873.         CASE N4                                  ' EMS Memory Change
  874.             IF SrDontUseEMS THEN
  875.                 SrDontUseEMS = No
  876.                 UseEMS$ = True$
  877.               ELSE
  878.                 SrDontUseEMS = Yes
  879.                 UseEMS$ = False$
  880.             END IF
  881.         CASE N5                                  ' Disk Swap Change
  882.             NoSwapping = No
  883.             IF UseDiskSwap$ = False$ THEN
  884.                 SrDiskSwapping = Yes
  885.                 UseDiskSwap$ = True$
  886.               ELSE
  887.                 SrDiskSwapping = No
  888.                 UseDiskSwap$ = False$
  889.             END IF
  890.         CASE 6                                  ' Disk Swap Path Change
  891. NewDiskPath:
  892.             BoxRow = MenuRow + MenuSize + N3
  893.             MessageRow = BoxRow - N1
  894.             InputResponse$ = SrSwapPath$
  895.             CALL ControlledInput(BoxRow, N1, MessageRow, N1, 66, _
  896.               ("Enter Drive/Directory for Swap Files " + _
  897.                "CALSWAP.000 & 001 & Screen File CALSCRN.DAT"), _
  898.               InputResponse$, N0, N1, N1, N1)
  899.             CALL BlankError
  900.             IF Keystroke$ = CHR$(Esc) THEN GOTO MemResOptionsMenu
  901.             '    Make upper case, no leading or trailing spaces
  902.             SrSwapPath$ = LTRIM$(RTRIM$(UCASE$(InputResponse$)))
  903.             '    Valid Drive Name and separator
  904.             IF NOT DirectoryExist(SrSwapPath$) THEN
  905.                 GOTO SwapPathError
  906.             END IF
  907.             IF RIGHT$(SrSwapPath$, N1) <> "\" THEN
  908.                 SrSwapPathAdjusted$ = SrSwapPath$ + "\"
  909.               ELSE
  910.                 SrSwapPathAdjusted$ = SrSwapPath$
  911.             END IF
  912.             EgaFilePath$ = SrSwapPathAdjusted$ + EgaFilename$
  913.             EgaFilePath2$ = ASCIIZ$(EgaFilePath$)
  914.         CASE 7                                  ' Snow Checking
  915. SnowChecking:
  916.             IF SrSnowCheck THEN            'If turning it off, just
  917.                 CALL SrNoSnow            '  do it
  918.                 SrSnowCheck = No
  919.               ELSE
  920.                 CALL SrCancelAutoScreenSave
  921.                 CALL SrAutoScreenSave(EgaFilePath2$, Ecode%)
  922.                 IF Ecode THEN            'If turning it on, then
  923.                     SnowReset = Yes    ' have to kill and restart
  924.                     SrSnowCheck = No    ' auto screen save, which
  925.                   ELSE                ' is okay, because when 
  926.                     SrSnowCheck = Yes    ' popped up, there's nothing
  927.                 END IF                ' being held
  928.             END IF
  929.         CASE 8                                  ' Protect Non-Standard Screen
  930.             IF SrPopupOnlyIfScreenSaved THEN
  931.                 SrPopupOnlyIfScreenSaved = No        ' Turn off
  932.               ELSE
  933.                 SrPopupOnlyIfScreenSaved = Yes    ' Turn on
  934.             END IF
  935.     END SELECT
  936.     GOTO MemResOptionsMenu
  937.     '--------------------------------------------------------------------
  938.     '  Invalid Swap Path
  939. SwapPathError:
  940.     CALL PrepareforMessage
  941.     CALL MajorBeeper
  942.     CALL ShowIt(N0, N0, N0, _
  943.         "The Drive & Path You Specified Does Not Exist--Try Again")
  944.     SrSwapPath$ = ValidSwapPath$
  945.     GOTO NewDiskPath      ' Try Again
  946.     '--------------------------------------------------------------------
  947.     '  Change Hot Key
  948. NewHotKey:
  949.     CALL ClearScreenNormal(N1)
  950.     ScreenTitles$(N1) = "Choose Hot Key for Program Pop Up"
  951.     ScreenTitles$(N2) = "Control and/or Function Key Combination"
  952.     ScreenTitles$(N3) = "(Please Consult Help Text For Explanation)"
  953.     CALL Titles(-3)
  954.     IF NoKeyChoice THEN
  955.         CALL PrepareforMessage
  956.         CALL ShowIt(N0, N0, N0, _
  957.             "You Must Choose At Least a Control Key or a Function Key")
  958.         NoKeyChoice = No
  959.     END IF
  960.     XCL1 = N12           ' Column Positions
  961.     XCL2 = 55
  962.     MenuRow = N7
  963.     CALL ShowIt(N13, MenuRow - N1, XCL1 + N7, "Control Keys")
  964.     CALL ShowIt(N0, MenuRow - N1, XCL2, "Function Key")
  965.     CALL Kolors(N6)
  966.     IF LEN(SrHotKeyName$) > N19 THEN
  967.         NameWidth = LEN(SrHotKeyName$)
  968.       ELSE
  969.         NameWidth = N19
  970.     END IF
  971.     CALL BoxDraw(N1, N20, N23, XCL2 - N11, XCL2 - N11 + NameWidth + N3)
  972.     CALL ShowIt(N6, N21, (XCL2 - N9), "Current Hot Key Is:")
  973.     CALL ShowIt(N7, Nm1, N0, SrHotKeyName$)
  974.     ShiftChoice = SrKshiftHot
  975.     ScanChoice = SrScanChoice
  976.     FOR WhichKey = N1 TO N2
  977.         ' Calculate Displacements Based On Which Key Half Is Being Selected
  978.         IF WhichKey = N1 THEN
  979.             XCL = XCL1
  980.             MenuChoice = ShiftChoice + N1
  981.             MenuSize = NumberofHotCKeys
  982.             FOR I = N1 TO MenuSize                   ' Fill Name Part 1
  983.                 MenuLines(I) = HotKeyNames$(I)
  984.             NEXT I
  985.             FOR I = N1 TO NumberofHotFKeys + N1        ' Show FN Keys
  986.                 IF (I = N1 AND ScanChoice = N0) OR _
  987.                    (I > N1 AND (I = ScanChoice + N1)) THEN
  988.                     ScanColor = N7
  989.                   ELSE
  990.                     ScanColor = N6
  991.                 END IF
  992.                 IF I = N1 THEN
  993.                     ToShow$ = "No F Key"
  994.                   ELSE
  995.                     ToShow$ = "F" + LTRIM$(STR$(I - N1))
  996.                 END IF
  997.                 CALL ShowIt(ScanColor, MenuRow + I, (XCL2 + N2), ToShow$)
  998.             NEXT I
  999.           ELSE
  1000.             XCL = XCL2
  1001.             MenuChoice = ScanChoice + N1
  1002.             MenuSize = NumberofHotFKeys + N1
  1003.             MenuLines(N1) = "No F Key"
  1004.             FOR I = N2 TO MenuSize
  1005.                 MenuLines(I) = "F" + LTRIM$(STR$(I - N1))' File Name Part 2
  1006.             NEXT I
  1007.             FOR I = N1 TO NumberofHotCKeys           ' Show C Keys
  1008.                 IF I = (ShiftChoice + N1) THEN 
  1009.                     ScanColor = N7 
  1010.                   ELSE 
  1011.                     ScanColor = N6
  1012.                 END IF
  1013.                 CALL ShowIt(ScanColor, (MenuRow + I), (XCL1 + N2), _
  1014.                     (HotKeyNames$(I)))
  1015.             NEXT I
  1016.         END IF
  1017.         CALL MenuDriver(MenuSize, MenuChoice, MenuRow, XCL, No, _
  1018.             N0, N1, N1)
  1019.         IF MenuExit = MenuCancelled AND WhichKey = N1 THEN RETURN
  1020.         IF WhichKey = N1 THEN
  1021.             ShiftChoice = MenuChoice - N1
  1022.             ' Clear Left Menu and Leave Chosen Key Name There
  1023.             '  on 2nd cycle through For Loop
  1024.             CALL ShowMult(N6, MenuRow, XCL1, (BoxWidth + N2), _
  1025.                 (MenuSize + N2))
  1026.           ELSE
  1027.             ScanChoice = MenuChoice - N1
  1028.         END IF
  1029.     NEXT WhichKey
  1030.     IF ShiftChoice = N0 AND ScanChoice = N0 THEN
  1031.         NoKeyChoice = Yes
  1032.         GOTO NewHotKey
  1033.     END IF
  1034.     SrKshiftHot = ShiftChoice
  1035.     CALL StayResKeyShiftList
  1036.     IF ScanChoice > N0 THEN
  1037.         SrKscanHot = FunctionScanCodes(SrWhichFList, ScanChoice)
  1038.       ELSE
  1039.         SrKscanHot = N0
  1040.     END IF
  1041.     CALL StayResKeyName
  1042.     RETURN
  1043.     '--------------------------------------------------------------------
  1044. ExitPoint2:
  1045.         Subnum = SubnumSave
  1046.     END SUB
  1047.     '=========================================================================
  1048.     SUB StayResPopDown STATIC
  1049.     '=========================================================================
  1050.     DEFINT A-Z
  1051.         SubnumSave = Subnum
  1052.         Subnum = 85
  1053.     '--------------------------------------------------------------------
  1054.     '  Become Memory Resident 1st Time or Pop Down if Already Resident
  1055.     '--------------------------------------------------------------------
  1056.     Keystroke$ = INKEY$
  1057.     Keystroke$ = Blank0$                    ' discard keystroke on pop-down
  1058.     ScreenWait! = 2!
  1059.     AvailableStringSpace& = FRE(Blank0$)    ' garbage collection
  1060.     '--------------------------------------------------------------------
  1061.     LOCATE CursorRow, CursorColumn, N0        ' turn calendar cursor off
  1062.     CALL WindowSave                        '   and save calendar screen
  1063.     '--------------------------------------------------------------------
  1064.     IF NOT MemoryResident THEN
  1065.         '--------------------------------------------------------------------
  1066.         ' First Call To SrPopDown
  1067.         ' Check Whether Options Exist, If Not, Set Them
  1068.         '--------------------------------------------------------------------
  1069.         IF NOT SrOptionsChosen THEN        ' If any menu data exists,
  1070.             InHelpSave = InHelp
  1071.             HardSnooze = Yes
  1072.             IF MenuSingleLine OR InMenu THEN GOSUB RecursiveMenuSave
  1073.                                     '  save before processing
  1074.             CALL StayResOptions(Yes)      '  options, as options menu will
  1075.             IF MenuSingleLineSave OR InMenuSave THEN
  1076.                 GOSUB RecursiveMenuRestore
  1077.             END IF
  1078.             InHelp = InHelpSave
  1079.             Keystroke$ = Blank0$        '  clobber previous menu.
  1080.         END IF                             '  after options are complete
  1081.         '--------------------------------------------------------------------
  1082.         ' Search the environment for 4DOS and add 7000 to the memory
  1083.         ' protection if found, because 4DOS' command processor is larger.
  1084.         EnvIndex = N1
  1085.         DO WHILE LEN(ENVIRON$(EnvIndex))                'Check environment
  1086.                EnvCheck$ = ENVIRON$(EnvIndex)            ' comspec for
  1087.                IF INSTR(LCASE$(EnvCheck$), "4dos.com") THEN    ' for "4dos.com"
  1088.                     Using4DOS = Yes                    ' yes it's there
  1089.                     EXIT DO
  1090.                  ELSE
  1091.                     Using4DOS = No                        ' no it's not
  1092.                END IF
  1093.                EnvIndex = EnvIndex + N1
  1094.           LOOP
  1095.         '--------------------------------------------------------------------
  1096.         '  See if enough memory for TSR Mode
  1097.         '  SRP4 tests for at least 64K after doing an internal BASIC SETMEM
  1098.         SrUserMemProtect& = 10& * 1024&    'Protect 10K of dynamic
  1099.         MemoryLeft& = FRE(-1)            ' Available far memory less
  1100.                                     ' a margin must be available
  1101.         MemoryOK& = MemoryLeft& - SrUserMemProtect& - 64& * 1024&
  1102.         IF Using4DOS THEN
  1103.             MemoryOK& = MemoryOK& - 7000&
  1104.         END IF
  1105.         IF MemoryOK& < 0& THEN            ' If not enough memory, then
  1106.             SrAutoPopDown = No            '  cancel AutoPopDown
  1107.             SrAutoPopDownReady = No        '  and cancel Pop down with a
  1108.             SrAutoPopDownHappened = No    '  message
  1109.             ErrorLine1$ = _
  1110.            "Temporarily-Needed DOS Memory To Pop Down Is Insufficient By " + _
  1111.                 STR$(-MemoryOK&) + " Bytes"
  1112.             ERROR 253
  1113.         END IF
  1114.         '--------------------------------------------------------------------
  1115.         CALL SrAutoScreenSave(EgaFilePath2$, Ecode%)   'Set Screen Save On
  1116.         IF Ecode THEN
  1117.             ErrorLine1$ = _
  1118.            "Disk Swap/Screen Save File Path is Longer than 65 Bytes"
  1119.             ERROR 253
  1120.         END IF
  1121.         '--------------------------------------------------------------------
  1122.         IF NOT SrSetUserMemCalled THEN    ' memory (does internal SETMEM)
  1123.             CALL SrSetUserMem(SrUserMemProtect&) 
  1124.             SrSetUserMemCalled = Yes
  1125.         END IF
  1126.         '--------------------------------------------------------------------
  1127.         CALL SrForceFile0           ' Set Swap File Exts to 000 and 001
  1128.         '--------------------------------------------------------------------
  1129.         '  Choose EMS or Disk Swapping or Neither Here and Enable EMS
  1130.         '--------------------------------------------------------------------
  1131.         IF SrDontUseEMS THEN         ' EMS Swap Overrides Disk Swap
  1132.             SrEMS = No
  1133.           ELSE
  1134.             CALL SrCheckEMS(Ecode%)
  1135.             IF Ecode THEN            ' Set No EMS Available Flag
  1136.                 SrEMS = No
  1137.               ELSE                ' EMS swapping is set
  1138.                 SrEMS = Yes
  1139.                 SrDiskSwapping = No
  1140.             END IF
  1141.         END IF
  1142.         '--------------------------------------------------------------------
  1143.         '  Disk Swapping Initialization
  1144.         IF NOT SrEMS AND SrDiskSwapping THEN
  1145.             SrDiskCantSwap = No
  1146.             CALL SetCurrentDirectory(N2)   ' Check Disk Swap Space
  1147.             DiskOK& = 0&
  1148.             IF Ecode THEN                 ' Ecode returned from last CALL
  1149.                 SrDiskCantSwap = Yes          ' No Drive
  1150.               ELSE
  1151.                 Directory$ = SPACE$(65)
  1152.                 CALL MhDisk(DriveSet%, Directory$, FreeDisk&, _
  1153.                     TotalSpace&, Ecode%)
  1154.                 IF Ecode THEN SrDiskCantSwap = Yes
  1155.                 SwapFileSize& = 228200&        ' Obtained by observation
  1156.                 DiskOK& = FreeDisk& - SwapFileSize& * N2
  1157.                 IF DiskOK& < 0& AND NOT SrDiskCantSwap THEN
  1158.                     SrDiskCantSwap = Yes
  1159.                   ELSE
  1160.                     ' Initialize Disk Swapping
  1161.                     SrDiskPathToSet$ = SrSwapPathAdjusted$ + "calswap"
  1162.                     ' Turn On Disk Swapping Here
  1163.                     CALL SrSetDiskSwap(SrDiskPathToSet$, SwapEcode%)
  1164.                     IF SwapEcode% THEN
  1165.                         SrDiskSwapping = No
  1166.                         SrDiskCantSwap = Yes
  1167.                       ELSE
  1168.                         SrDiskSwapped = Yes           ' Made It!
  1169.                         SrActualSwapPath$ = SrSwapPath$' Save Real Path
  1170.                     END IF
  1171.                 END IF
  1172.                 CALL SetCurrentDirectory(N1)        ' Return to calendar
  1173.             END IF
  1174.         END IF
  1175.         '--------------------------------------------------------------------
  1176.         KscanRes = SrKscanHot                'Set Initial Hot Keys
  1177.         KshiftRes = SrKshiftHot
  1178.         '--------------------------------------------------------------------
  1179.     END IF
  1180.     '--------------------------------------------------------------------
  1181.     '  Enable the Pop-Up on Date/Time only if in Clock Screen
  1182.     SrPopString$ = RIGHT$(STR$(SrPopTime#), N12)
  1183.     SrYear = VAL(MID$(SrPopString$, N1, N4))
  1184.     SrMonth = VAL(MID$(SrPopString$, N5, N2))
  1185.     SrDay = VAL(MID$(SrPopString$, N7, N2))
  1186.     SrHour = VAL(MID$(SrPopString$, N9, N2))
  1187.     SrMinute = VAL(MID$(SrPopString$, N11, N2))
  1188.     '--------------------------------------------------------------------
  1189.     '  POPPING DOWN ... or AUTO POP DOWN ... Screen    
  1190.     '--------------------------------------------------------------------
  1191.     TimerDisplaySuppressSave = TimerDisplaySuppress
  1192.     LOCATE , , N0
  1193.     CALL ClearScreenNormal(N0)
  1194.     CursorStateHold = CursorState
  1195.     CursorState = N0
  1196.     '--------------------------------------------------------------------
  1197.     IF AllowPopDateTime * SrPopDateTime * EventTableStable * _
  1198.        EventsScheduled * ApptFile THEN
  1199.         WhichEvent = N1
  1200.         CALL ApptToMenu(N1)
  1201.         CALL SrSetTimeY(SrMonth%, SrDay%, SrYear%, SrHour%, SrMinute%)
  1202.         PopShow$ = RTRIM$(LTRIM$(LEFT$(CurrentEventLine$, 76)))
  1203.         IF LEN(PopShow$) < (N80 - N21) THEN
  1204.             PopShowLine = N13
  1205.             PopShowColumn = N20
  1206.           ELSE
  1207.             PopShowLine = N14
  1208.             PopShowColumn = Nm2        ' center long line
  1209.         END IF
  1210.       ELSE
  1211.         CALL SrReleaseTimeY
  1212.         PopShow$ = "Disabled"
  1213.         IF AllowPopDateTimeSave THEN 
  1214.             PopShow$ = PopShow$ + " (temporarily)"
  1215.         END IF
  1216.         PopShowLine = N13
  1217.         PopShowColumn = N0
  1218.     END IF
  1219.     '--------------------------------------------------------------------
  1220.     CALL BoxDraw(N2, N1, N25, N1, N80)
  1221.     CALL Kolors(N7)
  1222.     IF SrAutoPopDownReady AND NOT SrAutoPopDownHappened THEN
  1223.         ScreenTag$ = "Auto Pop"
  1224.       ELSE
  1225.         ScreenTag$ = "Popping"
  1226.     END IF
  1227.     CALL BigChars(N3%, N10%, ScreenTag$ + " Down ... ")
  1228.     CALL Kolors(N6)
  1229.     CALL ShowIt(N0, N10, N10, "Hot Key:")        'Line 10
  1230.     CALL ShowIt(N0, Nm3, N6, "Auto Pop-Up:")    'Line 13
  1231.     CALL ShowIt(N0, Nm3, N6, "Swap Method:")    'Line 16
  1232.     CALL ShowIt(N0, Nm1, N8, "Swap Path:")        'Line 17
  1233.     CALL ShowIt(N0, Nm3, N3, "Screen Restore:")    'Line 20
  1234.     CALL ShowIt(N0, Nm1, N7, "Video BIOS:")        'Line 21
  1235.     CALL ShowIt(N0, Nm2, N4, "Pop Down Type:")    'Line 23
  1236.     CALL ShowIt(N0, Nm1, N6, "DOS Command:")    'Line 24
  1237.     '--------------------------------------------------------------------
  1238.     IF ColorCRT THEN 
  1239.         CALL Kolors(N7) 
  1240.       ELSE 
  1241.         CALL Kolors(N4)
  1242.     END IF
  1243.     CALL ShowIt(N0, N10, N20, SrHotKeyName$)
  1244.     CALL ShowIt(N0, PopShowLine, PopShowColumn, PopShow$)
  1245.     '--------------------------------------------------------------------
  1246.     IF SrEMS THEN
  1247.         CALL ShowIt(N0, N16, N20, "Swapping to Expanded (EMS) Memory")
  1248.       ELSEIF SrDiskSwapped THEN
  1249.         CALL ShowIt(N0, N16, N20, _
  1250.             "Swapping to Real or Virtual Disk files CALSWAP.000 & 001")
  1251.         IF LEN(SrActualSwapPath$) < (N80 - N21) THEN
  1252.             ShowLine = N17
  1253.             ShowColumn = N20
  1254.           ELSE
  1255.             ShowLine = N18
  1256.             ShowColumn = Nm2    ' center long line
  1257.         END IF
  1258.         CALL ShowIt(N0, ShowLine, ShowColumn, SrActualSwapPath$)
  1259.       ELSE
  1260.         CALL ShowIt(N0, N16, N20, "Program Will Remain In DOS Memory")
  1261.         ScreenTag$ = Blank0$
  1262.         IF (UseEMS$ = True$) AND NOT SrEMS THEN
  1263.             ScreenTag$ = "No EMS Memory"
  1264.         END IF
  1265.         IF (UseDiskSwap$ = True$) AND SrDiskCantSwap THEN
  1266.             IF LEN(ScreenTag$) THEN ScreenTag$ = ScreenTag$ + " and "
  1267.             IF DiskOK& THEN
  1268.                 DiskTag$ = "Disk Space Is " + STR$(DiskOK&) + " Bytes Short"
  1269.               ELSE
  1270.                 DiskTag$ = "Disk Drive/Path Not Found"
  1271.             END IF
  1272.             ScreenTag$ = ScreenTag$ + DiskTag$
  1273.         END IF
  1274.         IF LEN(ScreenTag$) THEN
  1275.             CALL MinorBeeper                   ' Error Chirp & Longer Wait
  1276.             CALL Kolors(N20)                    ' Hilit and Blinking
  1277.             CALL ShowIt(N0, Nm1, N25, ScreenTag$)
  1278.         END IF
  1279.     END IF
  1280.     '--------------------------------------------------------------------
  1281.     IF ColorCRT THEN CALL Kolors(N7) ELSE CALL Kolors(N4)
  1282.     IF NOT MemoryResident OR NOT SrScreenSaved THEN
  1283.         CALL ShowIt(N0, N20, N20, "No Saved Screen To Restore")
  1284.       ELSE
  1285.         ScreenTag$ = "Mode" + STR$(UserMode) + " page" + _
  1286.             STR$(DOSCursorPage)
  1287.         CALL ShowIt(N0, N21, N20, ScreenTag$)
  1288.         ScreenTag2$ = ScreenModes$(UserMode + N1)
  1289.         SearchFor$ = "x 25"
  1290.         Pointer = InString(ScreenTag2$, SearchFor$)
  1291.         IF Pointer THEN                    ' fix up the 80 x 25
  1292.             SELECT CASE UserRows            ' label if it's 43 or 50
  1293.                 CASE N43                    ' line mode for display
  1294.                     TagFix$ = "x 43"
  1295.                 CASE N50
  1296.                     TagFix$ = "x 50"
  1297.                 CASE ELSE
  1298.                     GOTO ShowTag
  1299.             END SELECT
  1300.             CALL Myd2(ScreenTag2$, Pointer%, N4%, TagFix$)
  1301.         END IF
  1302. ShowTag:
  1303.         CALL ShowIt(N0, N20, N20, ScreenTag2$)
  1304.     END IF
  1305.     IF MemoryResidentShell THEN
  1306.         ScreenTag1$ = "Execute DOS Session with Program or Batch File"
  1307.         ScreenTag2$ = LEFT$(SrShellCommand$, 59)
  1308.       ELSE
  1309.         ScreenTag1$ = "Normal Pop Down"
  1310.         ScreenTag2$ = Blank0$
  1311.     END IF
  1312.     CALL ShowIt(N0, N23, N20, ScreenTag1$)
  1313.     CALL ShowIt(N0, Nm1, N0, ScreenTag2$)
  1314.     '--------------------------------------------------------------------
  1315.     InPopDown = Yes                ' Avoid Recursive F10's
  1316.     CALL Snooze(ScreenWait!)            ' Wait (user reads screen)
  1317.     CALL SetVideoMode(N1)             ' Set users mode if necessary
  1318.     '--------------------------------------------------------------------
  1319.     IF NOT MemoryResident THEN        ' if stay-res isn't restoring screen,
  1320.         CALL SetVideoPage(N1)        ' set user's page if necessary
  1321.         CALL RestoreDOSKeyState        ' And user's cursor and lines
  1322.         SELECT CASE UserMode        ' If in text mode
  1323.             CASE 0, 1, 2, 3, 7        '  restore DOS colors
  1324.                 CALL Kolors(N99)    '  do a cursor, clear screen
  1325.                 LOCATE N1, N1, N1, InsertCursorStart, CursorStop
  1326.                 CLS
  1327.         END SELECT
  1328.     END IF
  1329.     '--------------------------------------------------------------------
  1330.     CALL SetCurrentDirectory(N0)       ' Set User's Directory
  1331.     '--------------------------------------------------------------------
  1332.     IF NOT MemoryResidentShell THEN     ' If not shelling, make sure to
  1333.         CALL SrCancelShell            '  cancel it
  1334.     END IF
  1335.     '--------------------------------------------------------------------
  1336.     '    Redefine Hot Key on Each Call as User Can Change It
  1337.     CALL SrResetHotKey(SrKscanHot%, SrKshiftHot%)
  1338.     '--------------------------------------------------------------------
  1339.     DO
  1340.         '---------------------------------------------------------------
  1341.         CALL SrSetBusyWait(90%)        ' Wait 5 seconds if DOS is busy
  1342.         '---------------------------------------------------------------
  1343.         '         POP DOWN HERE !!!!
  1344.         '---------------------------------------------------------------
  1345.         CALL SrPopDown(KscanRes%, KshiftRes%, ResEcode%)
  1346.         '---------------------------------------------------------------
  1347.         '         POP UP HERE !!!!
  1348.         '---------------------------------------------------------------
  1349.         '  If DOS is busy, we can't go on until finished
  1350.         '        or shelling
  1351.         '---------------------------------------------------------------
  1352.         DOSBusy = No
  1353.         IF ResEcode = 1 OR _
  1354.            (NOT SrScreenSaved AND SrPopupOnlyIfScreenSaved) THEN
  1355.             DOSBusy = Yes              'Set up repeat.
  1356.             GOSUB SafeSoundBleep    'Sound the speaker safely
  1357.         END IF
  1358.         '---------------------------------------------------------------
  1359.     LOOP WHILE DOSBusy                  ' Loop if DOS or Shelling is Busy
  1360.     '-------------------------------------------------------------------------
  1361.     CALL SaveCurrentDirectory(N0)       ' Save User Directory
  1362.     CALL SetCurrentDirectory(N1)        ' Set Calendar Directory
  1363.     '-------------------------------------------------------------------------
  1364.     IF NOT MemoryResident AND ResEcode > N1 THEN
  1365.         Ecode = ResEcode
  1366.         MemoryResident = No
  1367.         ERROR 254      ' Did Not Go Resident--Trap Error
  1368.     END IF
  1369.     '--------------------------------------------------------------------
  1370.     SrAutoPopDownHappened = Yes        ' Turn off Auto Pop Down
  1371.     '-------------------------------------------------------------------------
  1372.     MemoryResident = Yes            ' We are now memory-resident
  1373.     '-------------------------------------------------------------------------
  1374.     CALL SaveDOSKeyState               ' Save user cursor, page, etc
  1375.     '--------------------------------------------------------------------
  1376.     UserMode = KscanRes                ' Save User Video Mode
  1377.     CurrentVideoMode = KscanRes
  1378.     '--------------------------------------------------------------------
  1379.     CALL SetVideoMode(N0)            ' Set Calendar's Video Mode & Page
  1380.     CALL SetVideoPage(N0)
  1381.     '--------------------------------------------------------------------
  1382.     LOCATE , , N0                    ' Turn off cursor
  1383.     '--------------------------------------------------------------------
  1384.     IF NOT SrScreenSaved AND NOT SrPopupOnlyIfScreenSaved THEN
  1385.         CALL MinorBeeper
  1386.         CALL ClearScreenNormal(N0)
  1387.         CALL BoxDraw(N2, N7, N18, N6, N74)
  1388.         CALL ShowIt (N0, N9, N9, _
  1389.             "Personal Calendar popped up over a program whose screen is")
  1390.         CALL ShowIt (N0, Nm1, N0, _
  1391.             "in non-standard video BIOS mode" + STR$(UserMode) + _
  1392.             ", so the screen can't")
  1393.         CALL ShowIt (N0, Nm1, N0, _
  1394.             "be saved.  On your next pop down to the program, the screen")
  1395.         CALL ShowIt (N0, Nm1, N0, _
  1396.             "won't be restored.  If the industry ever standardizes this")
  1397.         CALL ShowIt (N0, Nm1, N0, _
  1398.             "video mode, a future version of Personal Calendar will be")
  1399.         CALL ShowIt (N0, Nm1, N0, _
  1400.                "enhanced to support it.  If you'd rather not disturb these")
  1401.         CALL ShowIt (N0, Nm1, N0, _
  1402.             "non-standard screens (don't pop up over them), reset your")
  1403.         CALL ShowIt (N0, Nm1, N0, _
  1404.             "Memory-Resident Options accordingly.  Press a key ...")
  1405.         DO
  1406.         LOOP UNTIL LEN(INKEY$)
  1407.     END IF
  1408.     '--------------------------------------------------------------------
  1409.     CALL PoppedOverCheck               ' See If Over DOS or Program for Later
  1410.     '--------------------------------------------------------------------
  1411.     IF KshiftRes = N7 THEN             ' Reset Pop On Date/Time
  1412.         SrPopDateTime = No            '  so it can't repeat
  1413.     END IF
  1414.     IF AllowPopDateTimeSave THEN
  1415.         AllowPopDateTime = AllowPopDateTimeSave      'Restore Autopop Flag
  1416.         AllowPopDateTimeSave = No
  1417.     END IF                                            ' if turned off
  1418.     '--------------------------------------------------------------------
  1419.     ' Let user clear batch screen if there is one
  1420.     IF MemoryResidentShell THEN 
  1421.         CALL ShowErase(N13, N1, N1, N80, Blank0$)
  1422.         CALL ShowIt(N7, N1, Nm2, _
  1423.             " Press a Key to Return to Personal Calendar ... ")
  1424.         DO
  1425.         LOOP UNTIL LEN(INKEY$)
  1426.     END IF
  1427.     '--------------------------------------------------------------------
  1428.     CLS                            ' Clear the screen
  1429.     '--------------------------------------------------------------------
  1430.     CALL WindowRestore                   ' Restore Calendar Screen
  1431.     '--------------------------------------------------------------------
  1432.     CursorState = CursorStateHold        ' Restore Saved Cursor State
  1433.     CALL RestoreCalKeyState            '  and key statuses and cursor
  1434.     '--------------------------------------------------------------------
  1435.     TimerDisplaySuppress = TimerDisplaySuppressSave
  1436.     InPopDown = No
  1437.     GOTO ExitPoint3
  1438.     '--------------------------------------------------------------------
  1439.     ' Copied from Tony Elliott's sample program for safe sound
  1440.     '  while DOS is busy
  1441. SafeSoundBleep:
  1442.     ScreenWait! = 3!
  1443.     OUT 67, 182                     'Tell timer that data is coming.
  1444.     OUT &H43, 182                     'Set up for sound.
  1445.     OUT &H42, &H33                    'Low part of sound.
  1446.     OUT &H42, N5                      'High part of sound.
  1447.     SpkrOn% = INP(97) OR &H3            'Turn speaker on by setting
  1448.         OUT 97, SpkrOn%                '  bits 0 and 1 of PPI chip.
  1449.     FOR A% = 1 TO 12000                'Delay
  1450.     NEXT
  1451.     OUT &H42, &H33                     'Low part second tone.
  1452.     OUT &H42, N6                        'High part second tone.
  1453.     FOR A% = 1 TO 12000
  1454.     NEXT                            'Delay.
  1455.         SpkrOff% = INP(97) AND &HFC        'Turn speaker off.
  1456.         OUT 97, SpkrOff%
  1457.     RETURN
  1458.     '--------------------------------------------------------------------
  1459.     '  Save Menu Parameters
  1460. RecursiveMenuSave:
  1461.     InMenuSave = InMenu
  1462.     MenuSizeSave = MenuSize
  1463.     MenuChoiceSave = MenuChoice
  1464.     MenuRowSave = MenuRow
  1465.     ReqMenuColumnSave = ReqMenuColumn
  1466.     MenuSingleLineSave = MenuSingleLine
  1467.     MenuSpecialExitSave = MenuSpecialExit
  1468.     ScreenBottomsShowSave = ScreenBottomsShow
  1469.     FilenameShowSave = FilenameShow
  1470.     WhichColorSave = WhichColor
  1471.     WhichColor = N0
  1472.     CursorStateSave = CursorState
  1473.     AllowInsertModeSave = AllowInsertMode
  1474.     AllowInsertMode = No
  1475.     InsertSave = Insrt
  1476.     NumSave = Num
  1477.     CapsSave = Caps
  1478.     FOR I = N1 TO MenuSizeSave
  1479.         MenuLinesSave$(I) = MenuLines(I)
  1480.     NEXT I
  1481.     RETURN
  1482.     '--------------------------------------------------------------------
  1483.     ' Restore Menu Parameters
  1484. RecursiveMenuRestore:
  1485.     FOR I = N1 TO MenuSizeSave
  1486.         MenuLines(I) = MenuLinesSave$(I)
  1487.     NEXT I
  1488.     MenuSize = MenuSizeSave
  1489.     MenuChoice = MenuChoiceSave
  1490.     MenuRow = MenuRowSave
  1491.     ReqMenuColumn = ReqMenuColumnSave
  1492.     MenuSingleLine = MenuSingleLineSave
  1493.     MenuSpecialExit = MenuSpecialExitSave
  1494.     ScreenBottomsShow = ScreenBottomsShowSave
  1495.     FilenameShow = FilenameShowSave
  1496.     WhichColor = WhichColorSave
  1497.     CursorState = CursorStateSave
  1498.     MenuRecursiveReturn = Yes
  1499.     AllowInsertMode = AllowInsertModeSave
  1500.     Insrt = InsertSave
  1501.     Num = NumSave
  1502.     Caps = CapsSave
  1503.     RETURN
  1504.     '--------------------------------------------------------------------
  1505. ExitPoint3:
  1506.     HardSnooze = No
  1507.         Subnum = SubnumSave
  1508.     END SUB
  1509.     '=========================================================================
  1510.     FUNCTION Strng$ (RptTimes%, FillChar%)  STATIC
  1511.     '=========================================================================
  1512.     '  Generate Top Of Screen Titles
  1513.     '  Pos is Number of Lines, Neg is Number of Lines + DOS Title
  1514.     DEFINT A-Z
  1515.         SubnumSave = Subnum
  1516.         Subnum = 123
  1517.     Lin$ = SPACE$(RptTimes%)
  1518.     CALL MhString(Lin$, FillChar%)
  1519.     Strng$ = Lin$
  1520.         Subnum = SubnumSave
  1521.     END FUNCTION
  1522.     '=========================================================================
  1523.     SUB Titles (EntryPoint) STATIC
  1524.     '=========================================================================
  1525.     '  Generate Top Of Screen Titles
  1526.     '  Pos is Number of Lines, Neg is Number of Lines + DOS Title
  1527.     DEFINT A-Z
  1528.         SubnumSave = Subnum
  1529.         Subnum = 86
  1530.     NumberofLines = ABS(EntryPoint)
  1531.     IF EntryPoint < N0 THEN
  1532.         NumberofLines = NumberofLines + N1
  1533.         ScreenTitles$(NumberofLines) = "For Your Current DOS Directory"
  1534.     END IF
  1535.     SELECT CASE NumberofLines
  1536.         CASE 1 TO N5
  1537.             '  Compute Box
  1538.             TitleWidth = N0
  1539.             FOR I = N1 TO NumberofLines
  1540.                 ' Add Character To Beginning and End
  1541.                 ScreenTitles$(I) = Blank1$ + ScreenTitles$(I) + Blank1$
  1542.                 IF LEN(ScreenTitles$(I)) > TitleWidth THEN
  1543.                     TitleWidth = LEN(ScreenTitles$(I))
  1544.                 END IF
  1545.             NEXT I
  1546.             FOR I = N1 TO NumberofLines
  1547.                 CALL ShowIt(N13, I, Nm2, (SPACE$(TitleWidth)))
  1548.                 CALL ShowIt(N0, I, Nm2, (ScreenTitles$(I)))
  1549.             NEXT I
  1550.     END SELECT
  1551.         Subnum = SubnumSave
  1552.     END SUB
  1553.     '=========================================================================
  1554.     SUB UnpackApptRecord STATIC
  1555.     '=========================================================================
  1556.     ' Split Appointment File Record Into Individual Variables (Unpack)
  1557.     ' Pos  1- 2   EventYear$   Year     Last 2 Digits   (00-99)
  1558.     '      3- 4   EventMonth$  Month         2 Digits   (01-12)
  1559.     '      5- 6   EventDay$    Day           2 Digits   (01 -days in month)
  1560.     '      7- 8   EventHour$   Hour          2 Digits   (00-23)
  1561.     '      9-10   EventMinute$ Minute        2 Digits   (00-59)
  1562.     '     11-63   EventText$   Text  TextSize Chars    (Alphanumeric and
  1563.     '                                                 specials)
  1564.     '     68-69   EventLimRepeat$ Limited WDM    2 Digits   (01-99 or blank)
  1565.     '     70-72   EventRepeat$ (Bi)Wkly/Dly/Mthly  1 Alpha/(2 Num or 1 Alpha)
  1566.     '                              ("B"/"W"/"D"/"M"/"N"+digits/last)
  1567.     '     74-75   EventYear1st2$  Year    First 2 Digits   (19 or 20)
  1568.     '                                                          (Not Displayed)
  1569.     DEFINT A-Z
  1570.         SubnumSave = Subnum
  1571.         Subnum = 87
  1572.     CALL Myd2(EventYear$, N1%, N2%, CurrentEventRecord$)
  1573.     CALL MhMidString(EventMonth$, N1%, N2%, CurrentEventRecord$, N3%)
  1574.     CALL MhMidString(EventDay$, N1%, N2%, CurrentEventRecord$, N5%)
  1575.     CALL MhMidString(EventHour$, N1%, N2%, CurrentEventRecord$, N7%)
  1576.     CALL MhMidString(EventMinute$, N1%, N2%, CurrentEventRecord$, N9%)
  1577.     CALL MhMidString(EventText$, N1%, TextSize%, CurrentEventRecord$, N11%)
  1578.     CALL MhMidString(EventLimRepeat$, N1%, N2%, CurrentEventRecord$, N68%)
  1579.     CALL MhMidString(EventRepeat$, N1%, N3%, CurrentEventRecord$, N70%)
  1580.     CALL MhMidString(EventYear1st2$, N1%, N2%, CurrentEventRecord$, N74%)
  1581.         Subnum = SubnumSave
  1582.     END SUB
  1583.     '=========================================================================
  1584.     SUB UpdateClockScreen STATIC
  1585.     '=========================================================================
  1586.     DEFINT A-Z
  1587.         SubnumSave = Subnum
  1588.         Subnum = 88
  1589.     '--------------------------------------------------------------------
  1590.     '            Update The Display --
  1591.     '--------------------------------------------------------------------
  1592.     '     │ 12 │  1 │  2 │  3 │  4 │  5 │  6 │  7 │  8 │  9 │ 10 │ 11 │
  1593.     '    ▓▓░░░░▓░░░░▓░░░░▓░░░░▓░░░░▓░░░░▓░░░░▓░░░░▓░░░░▓░░░░▓░░░░▓░░░░▓▓
  1594.     '     0    5    10   15   20   25   30   35   40   45   50   55   60
  1595.     '-------------------------------------------------------------------------
  1596.     '   At Least a Second Has Changed--Compute New Values
  1597.     '   ... Since a pop down or SHELL may have occurred, a long time could pass
  1598.     '   ... All values must therefore be checked every time through here
  1599.     '-------------------------------------------------------------------------
  1600.     '     Break Down Into Year, Month, Day, Hour, Minute, Second, and Edit
  1601.     ' CurrentHour  Hour     CurrentMinute  Minute     CurrentSecond  Second
  1602.     '
  1603.     DateFromDOS$ = DATE$     ' Save close together in case we're computing
  1604.     TimeFromDOS$ = TIME$     '  across a change (albeit rare)
  1605.     '
  1606.     TodaysDate$ = MID$(DateFromDOS$, N7, N4) + _
  1607.         MID$(DateFromDOS$, N1, N2) + MID$(DateFromDOS$, N4, N2)
  1608.     CurrentYear = VAL(MID$(TodaysDate$, N1, N4))
  1609.     CurrentMonth = VAL(MID$(TodaysDate$, N5, N2))
  1610.     CurrentDay = VAL(MID$(TodaysDate$, N7, N2))
  1611.     CALL Myd2(CurrentDateTime$, N1, N8, TodaysDate$)
  1612.     CALL DayDate(TodaysDate$)
  1613.     CurrentDayOfWeek = IndexedDay
  1614.     '
  1615.     Jul$ = LTRIM$(STR$(JulianDate&))        ' At the Year 2000, Length
  1616.     JuLength = LEN(Jul$)                '  can end up "00 001" or 1, so
  1617.     Julian$ = Strng$(N6, N48) ' zeroinit    '  adjust
  1618.     CALL Myd2(Julian$, N7 - JuLength, JuLength, Jul$)
  1619.     CALL MhMidString(Julian$, N1%, N2%, Julian$, N2%)
  1620.     CALL Myd2(Julian$, N3, N1, Blank1$)
  1621.     '        
  1622.     CurrentTime$ = MID$(TimeFromDOS$, N1, N2) + _
  1623.         MID$(TimeFromDOS$, N4, N2) + MID$(TimeFromDOS$, N7, N2)
  1624.     CurrentHour = VAL(MID$(TimeFromDOS$, N1, N2))
  1625.     CurrentMinute = VAL(MID$(TimeFromDOS$, N4, N2))
  1626.     CurrentSecond = VAL(MID$(TimeFromDOS$, N7, N2))
  1627.     CurrentQuarter = CurrentMinute \ N15 + N1
  1628.     '    Combine Date/Time In Format yyyymmddhhmm For Testing
  1629.     CALL Myd2(CurrentDateTime$, N9, N4, CurrentTime$)
  1630.     CurrentDateTime# = VAL(CurrentDateTime$)
  1631.     '-------------------------------------------------------------------------
  1632.     '   Set First Time Prior Values
  1633.     IF FirstTimeClock THEN
  1634.         '--------------------------------------------------------------------
  1635.         '   On First Time, Initialize Prior Values For Clock Display
  1636.         PreviousHour = CurrentHour - N1
  1637.         IF CurrentHour = N0 THEN PreviousHour = N23
  1638.         PreviousMinute = CurrentMinute - N1
  1639.         IF CurrentMinute = N0 THEN PreviousMinute = 59
  1640.         PreviousSecond = CurrentSecond - N1
  1641.         IF CurrentSecond = N0 THEN PreviousSecond = 59
  1642.         PreviousQuarter = CurrentQuarter
  1643.     END IF
  1644.     '-------------------------------------------------------------------------
  1645.     IF FirstTimeClock OR TimeBlock OR WholeClock OR _
  1646.        PreviousDate$ <> TodaysDate$ THEN
  1647.         DisplayYear$ = MID$(TodaysDate$, N1, N4)
  1648.         IF MID$(TodaysDate$, N7, N1) = Zeroo$ THEN
  1649.             DisplayDay$ = RIGHT$(TodaysDate$, N1)
  1650.           ELSE
  1651.             DisplayDay$ = RIGHT$(TodaysDate$, N2)
  1652.         END IF
  1653.         FullClockDate$ = DayNames$(CurrentDayOfWeek) + ", " + _
  1654.             DisplayDay$ + Blank1$ + MonthNames$(CurrentMonth) + _
  1655.             Blank1$ + DisplayYear$
  1656.         '--------------------------------------------------------------------
  1657.         '  Construct and Display Date In English
  1658.         CALL ShowErase(N3, (ClockRow + N4), (ClockColumn + N14), 36, Blank0$)
  1659.         CALL ShowIt(N7, N0, (ClockColumn + N14 + _
  1660.             (36 - LEN(FullClockDate$)) \ N2), FullClockDate$)
  1661.         CALL ShowIt(N3, (ClockRow + N5), (ClockColumn + N28), _
  1662.             (" (" + Julian$ + ") "))
  1663.     END IF
  1664.     '-------------------------------------------------------------------------
  1665.     '    Label and Position for Hour Display  (order is 12,1,2,3,4,5,...)
  1666.     IF FirstTimeClock OR TimeBlock OR WholeClock OR _
  1667.        CurrentHour <> PreviousHour THEN
  1668.         IF CurrentHour > N11 THEN PMAM$ = "PM" ELSE PMAM$ = "AM"
  1669.         CurrentDisplayHour = CurrentHour
  1670.         IF CurrentHour > N12 THEN 
  1671.             CurrentDisplayHour = CurrentDisplayHour - N12
  1672.         END IF
  1673.         IF CurrentDisplayHour = N0 THEN 
  1674.             CurrentDisplayHour = N12      ' midnight
  1675.         END IF
  1676.         IF CurrentDisplayHour = N12 THEN
  1677.             CurrentHourPosition = N1
  1678.           ELSE
  1679.             CurrentHourPosition = CurrentDisplayHour + N1
  1680.         END IF
  1681.         IF FirstTimeClock THEN
  1682.             PrevQuarterPosition = CurrentHourPosition
  1683.         END IF
  1684.         Hours12Hour$ = BlankFill$(RIGHT$(STR$(CurrentDisplayHour), N2))
  1685.         Hours24Hour$ = ZeroFill$(RIGHT$(STR$(CurrentHour), N2))
  1686.         CurrentHour$ = BlankFill$(RIGHT$(STR$(CurrentDisplayHour), N2))
  1687.         PreviousDisplayHour = PreviousHour
  1688.         IF PreviousHour > N12 THEN 
  1689.             PreviousDisplayHour = PreviousDisplayHour - N12
  1690.         END IF
  1691.         IF PreviousDisplayHour = N0 THEN 
  1692.             PreviousDisplayHour = N12    ' midnight
  1693.         END IF
  1694.         '
  1695.         IF PreviousDisplayHour = N12 THEN
  1696.             PreviousHourPosition = N1
  1697.           ELSE
  1698.             PreviousHourPosition = PreviousDisplayHour + N1
  1699.         END IF
  1700.         '
  1701.         PreviousHour$ = BlankFill$(RIGHT$(STR$(PreviousDisplayHour), N2))
  1702.         '--------------------------------------------------------------------
  1703.         '     Hilight and Dehilight Current and Previous Hour Block On Clock
  1704.         CALL ShowIt(N10, (ClockRow + N1), (ClockColumn + N5 * _
  1705.             PreviousHourPosition - N1), (SPACE$(N4)))
  1706.         CALL ShowIt(N14, N0, (ClockColumn + N5 * CurrentHourPosition - N1), _
  1707.             (SPACE$(N4)))
  1708.         '--------------------------------------------------------------------
  1709.         '     Hilight and Dehilight Current and Previous Hours On Clock
  1710.         CALL ShowIt(N10, N0, (ClockColumn + N5 * PreviousHourPosition), _
  1711.             PreviousHour$)
  1712.         CALL ShowIt(N14, N0, (ClockColumn + N5 * CurrentHourPosition), _
  1713.             CurrentHour$)
  1714.     END IF
  1715.     '-------------------------------------------------------------------------
  1716.     IF FirstTimeClock OR TimeBlock OR WholeClock OR _
  1717.        CurrentMinute <> PreviousMinute THEN
  1718.         CurrentQuarter = CurrentMinute \ N15 + N1
  1719.         DisplayMinutes$ = ZeroFill$(RIGHT$(STR$(CurrentMinute), N2))
  1720.         '--------------------------------------------------------------------
  1721.         '  Hilight and Dehilight Current and Previous Quarter Hour Markers
  1722.         CALL ShowIt(N3, (ClockRow + N2), (ClockColumn + N5 * _
  1723.             (PrevQuarterPosition - N1) + PreviousQuarter + N3), _
  1724.              ClockPositionGraphic$)
  1725.         CALL ShowIt(N14, N0, (ClockColumn + N5 * (CurrentHourPosition - _
  1726.             N1) + CurrentQuarter + N3), MovingClockTick$)
  1727.         '--------------------------------------------------------------------
  1728.         '  Hilight and Dehilight Previous and Current Minute Markers On Clock
  1729.         '    Previous Minute
  1730.         ScreenRow = ClockRow + N6
  1731.         ScreenColumn = ClockColumn + PreviousMinute + N3
  1732.         '  (Don't Kill Current Second By Previous Minute)
  1733.         IF ScreenColumn <> (ClockColumn + CurrentSecond + N3) THEN
  1734.             IF (PreviousMinute MOD N5) = N0 THEN
  1735.                 CALL ShowIt(N3, N0, N0, ClockSeparatorGraphic$)
  1736.               ELSE
  1737.                 CALL ShowIt(N3, N0, N0, ClockPositionGraphic$)
  1738.             END IF
  1739.         END IF
  1740.         '    Current Minute
  1741.         ScreenColumn = ClockColumn + CurrentMinute + N3
  1742.         CALL ShowIt(N14, N0, N0, MovingClockTick$)
  1743.     END IF
  1744.     '-------------------------------------------------------------------------
  1745.     DisplaySeconds$ = ZeroFill$(RIGHT$(STR$(CurrentSecond), N2))
  1746.     '-------------------------------------------------------------------------
  1747.     '  Display Time In 24-Hour Format
  1748.     CALL ShowIt(N7, (ClockRow + N4), (ClockColumn + N6), (Hours24Hour$ + _
  1749.         ":" + DisplayMinutes$ + ":" + DisplaySeconds$))
  1750.     '-------------------------------------------------------------------------
  1751.     '  Display Time In 12-Hour Format
  1752.     CALL ShowIt(N7, N0, (ClockColumn + N50), (Hours12Hour$ + ":" + _
  1753.         DisplayMinutes$ + ":" + DisplaySeconds$ + Blank1$ + PMAM$))
  1754.     '-------------------------------------------------------------------------
  1755.     '  Hilight and Dehilight Previous and Current Second Markers On Clock
  1756.     '    Previous Second
  1757.     ScreenRow = ClockRow + N6
  1758.     ScreenColumn = ClockColumn + PreviousSecond + N3
  1759.     '  (Don't Kill Current Minute By Previous Second)
  1760.     IF ScreenColumn <> (ClockColumn + CurrentMinute + N3) THEN
  1761.         IF (PreviousSecond MOD N5) = N0 THEN
  1762.             CALL ShowIt(N3, N0, N0, ClockSeparatorGraphic$)
  1763.           ELSE
  1764.             CALL ShowIt(N3, N0, N0, ClockPositionGraphic$)
  1765.         END IF
  1766.     END IF
  1767.     '    Current Second
  1768.     CALL ShowIt(N14, N0, (ClockColumn + CurrentSecond + N3), MovingClockTick$)
  1769.     '-------------------------------------------------------------------------
  1770.     '   END OF TIME BLOCK CHANGES
  1771.     '-------------------------------------------------------------------------
  1772.     '   SET CHIME COUNT FOR HOUR OR QUARTER HOUR -- RINGS IN MAIN PROGRAM
  1773.     '-------------------------------------------------------------------------
  1774.     IF CurrentSecond = N0 THEN          ' Chime is set only on EXACT second
  1775.         IF CurrentMinute = N0 THEN     '  to avoid residual chiming
  1776.             '---------------------------------------------------------------
  1777.             ' Chime on hour, Chime is Hour base 12
  1778.             ChimeCount = CurrentDisplayHour
  1779.           ELSEIF CurrentMinute MOD N15 = N0 THEN
  1780.             '---------------------------------------------------------------
  1781.             '  Chime On Quarter Hour (15,30,45--once,twice,thrice)
  1782.             ChimeCount = CurrentMinute \ N15
  1783.         END IF
  1784.     END IF
  1785.     '-------------------------------------------------------------------------
  1786.     '    DAY OR EVENT CHANGED--SHOW NEW CALENDARS
  1787.     '-------------------------------------------------------------------------
  1788.     IF RedisplayCalendars OR TodaysDate$ <> PreviousDate$ THEN
  1789.         '--------------------------------------------------------------------
  1790.         '   Day Has Changed, Display Calendars
  1791.         '   (CalendarDate$ Date To Display Calendars For)
  1792.         IF NormalCalendars THEN
  1793.             OtherCalendars = No
  1794.             CalendarDate$ = TodaysDate$
  1795.           ELSE
  1796.             OtherCalendars = Yes
  1797.         END IF
  1798.         CALL PrintCalendar
  1799.         TimeBlock = Yes
  1800.         RedisplayNotesEvents = Yes
  1801.     END IF
  1802.     '-------------------------------------------------------------------------
  1803.         Subnum = SubnumSave
  1804.     END SUB
  1805.     '=========================================================================
  1806.     SUB ValidateEventDate STATIC
  1807.     '=========================================================================
  1808.     '   Accept Date In Editing, Check Validity And Change If Wrong, Delete
  1809.     DEFINT A-Z
  1810.         SubnumSave = Subnum
  1811.         Subnum = 89
  1812.     EventValidationError = N0
  1813.     ReturnMessage$ = Blank0$
  1814.     '=========================================================================
  1815.     '  Get The Event Repeat Type
  1816.     EventRepeatType$ = LEFT$(EventRepeat$, N1)
  1817.     '   Limit the Allowable Repeat Types
  1818.     IF InString("XxBbDdWwMmNnQqYy123456789", EventRepeatType$) = N0 THEN
  1819.         EventRepeatType$ = Blank1$
  1820.         EventRepeat$ = SPACE$(N3)
  1821.         EventLimRepeat$ = SPACE$(N2)
  1822.         GOTO CheckNumerics
  1823.     END IF
  1824.     '  Test If Numeric for Multiweek
  1825.     '   Non-Numeric
  1826.     '   Make Upper Case If Needed
  1827.     IF NumberError(EventRepeatType$) = N1 AND _
  1828.       (EventRepeatType$ < "A" OR EventRepeatType$ > "Z") THEN
  1829.         EventRepeatType$ = CHR$(ASC(EventRepeatType$) - N32)
  1830.         CALL Myd2(EventRepeat$, N1, N1, EventRepeatType$)
  1831.     END IF
  1832.     '   If "X" then Delete the Event
  1833.     IF EventRepeatType$ = "X" THEN
  1834.         '   And write the Deleted Record to History
  1835.         CALL ApptToMenu(N1)
  1836.         IF CurrentEventRecord$ <> Blank80$ THEN
  1837.             EventtoHistory = Yes
  1838.             HistoryBuffer$ = CurrentEventLine$
  1839.             CALL WritetoHistory
  1840.             CurrentEventRecord$ = Blank80$
  1841.             CALL MhLset(ApptBuffer$, Blank80$)
  1842.             EventTableStable = No
  1843.             CALL PutApptRecord(N1 + WhichEvent)   ' Put out the Old Record
  1844.             CALL UnpackApptRecord               ' Build Blank Menu Line
  1845.             EventDate$ = Blank8$
  1846.             EventTime$ = SPACE$(N4)
  1847.         END IF
  1848.         '           Write History and Blank out Record
  1849.         GOTO ExitPoint4
  1850.     END IF
  1851.     '=========================================================================
  1852.     '   If Limited Event, Edit Repeat Value, Present Consistently
  1853.     FOR JJ = N1 TO N2
  1854.         IF InString(" 0123456789", MID$(EventLimRepeat$, JJ, N1)) = N0 THEN
  1855.             ReturnMessage$ = "Invalid Repeat"
  1856.             GOTO ErrorReturn
  1857.         END IF
  1858.     NEXT JJ
  1859.     IF VAL(EventLimRepeat$) < N1 THEN
  1860.         EventLimRepeat$ = SPACE$(N2)
  1861.       ELSE
  1862.         EventLimRepeat$ = RIGHT$(STR$(VAL(EventLimRepeat$)), N2)
  1863.     END IF
  1864.     '=========================================================================
  1865.     '   If "D" then Daily Event
  1866.     IF EventRepeatType$ = "D" THEN
  1867.         '           Update Date
  1868.         EventRepeat$ = "D  "
  1869.     END IF
  1870.     '-------------------------------------------------------------------------
  1871.     '   If "B" or "W" or Multiweekly or Special Monthly "N"
  1872.     '     -- Make Sure Date is Correct for the Day of Week/Week of Month
  1873.     IF InString("BWN123456789", EventRepeatType$) THEN
  1874.         '  All Weekly Forms Must Have a Day of the Week
  1875.         IF InString("1234567", MID$(EventRepeat$, N2, N1)) = N0 THEN
  1876.             ReturnMessage$ = "Invalid Week Day"
  1877.             GOTO ErrorReturn
  1878.         END IF
  1879.         IF EventRepeatType$ <> "N" THEN
  1880.             CALL Myd2(EventRepeat$, N3, N1, Blank1$) ' B/W/Multi No 3rd Digit
  1881.           ELSE
  1882.             '  Special Monthly Must Have Which Week Specified
  1883.             IF InString("12345", MID$(EventRepeat$, N3, N1)) = N0 THEN
  1884.                 ReturnMessage$ = "Invalid Week"
  1885.                 GOTO ErrorReturn
  1886.             END IF
  1887.         END IF
  1888.     END IF
  1889.     '-------------------------------------------------------------------------
  1890.     '   If "M" or "Q" or "Y" then Monthly or Quarterly or Yearly Event
  1891.     '     -- Make Sure Date Correct or Last Day
  1892.     IF InString("MQY", EventRepeatType$) THEN
  1893.         IF InString("Ll", MID$(EventRepeat$, N2, N1)) THEN
  1894.             CALL Myd2(EventRepeat$, N2, N2, "L ")
  1895.           ELSE
  1896.             TestDay = VAL(MID$(EventRepeat$, N2, N2))
  1897.             IF TestDay < N1 OR TestDay > 31 THEN
  1898.                 ReturnMessage$ = "Invalid Day"
  1899.                 GOTO ErrorReturn
  1900.             END IF
  1901.         END IF
  1902.     END IF
  1903.     '=========================================================================
  1904.     '   Cursory Check for Numerics in Dates and Times
  1905. CheckNumerics:
  1906.     IF EventDate$ <> Blank8$ THEN
  1907.         IF NumberError(EventDate$) THEN
  1908.             ReturnMessage$ = "Non-Numeric Date"
  1909.             GOTO ErrorReturn
  1910.         END IF
  1911.     END IF
  1912.     IF EventTime$ <> SPACE$(N4) THEN
  1913.         IF NumberError(EventTime$) THEN
  1914.             ReturnMessage$ = "Non-Numeric Time"
  1915.             GOTO ErrorReturn
  1916.         END IF
  1917.     END IF
  1918.     '-------------------------------------------------------------------------
  1919.     '   Allow a Completely Blank Record
  1920.     EventTest$ = EventDate$ + EventTime$ + EventText$ + EventRepeat$ + _
  1921.         EventLimRepeat$
  1922.     IF EventTest$ = SPACE$(LEN(EventTest$)) THEN GOTO ExitPoint4
  1923.     '           Next Date If Recurring
  1924.     '-------------------------------------------------------------------------
  1925.     '   If No Date Is Given, Fill In Today's
  1926.     IF EventDate$ = Blank8$ THEN EventDate$ = TodaysDate$
  1927.     '-------------------------------------------------------------------------
  1928.     '   If No Time is Given, Fill In Current
  1929.     IF EventTime$ = SPACE$(N4) THEN EventTime$ = MID$(CurrentTime$, N1, N4)
  1930.     '-------------------------------------------------------------------------
  1931.     '   If Special Monthly, Set A Counter For Which Week of the Month
  1932.     IF EventRepeatType$ = "N" THEN
  1933.         SpecMonthlyCount = VAL(MID$(EventRepeat$, N3, N1))
  1934.         '   Determine a Working Date To Start From For Computation
  1935.         '   If Month Is Earlier, Check Just Year And Month
  1936.         IF MID$(EventDate$, N1, N6) < MID$(TodaysDate$, N1, N6) THEN
  1937.             CALL Myd2(EventDate$, N1, N6, TodaysDate$)
  1938.         END IF
  1939.         '   And Start At First Day Of Month
  1940. MonthStart:
  1941.         CALL Myd2(EventDate$, N7, N2, "01")'Start at First Day of the Month
  1942.         '--------------------------------------------------------------------
  1943.         ' If Rescheduling Special Monthly, First Increment Month, Maybe Year
  1944.         IF Rescheduling THEN
  1945.             Rescheduling = No
  1946.             SpecMonth = VAL(MID$(EventDate$, N5, N2))
  1947.             SpecMonth = SpecMonth + N1
  1948.             IF SpecMonth > N12 THEN
  1949.                 SpecYear = VAL(MID$(EventDate$, N1, N4))
  1950.                 SpecYear = SpecYear + N1
  1951.                 SpecMonth = N1
  1952.                 CALL YearAdjust(SpecYear, AdjustedYear$)
  1953.                 CALL Myd2(EventDate$, N1, N4, AdjustedYear$)
  1954.             END IF
  1955.             CALL Myd2(EventDate$, N5, N2, (RIGHT$(STR$(SpecMonth), N2)))
  1956.             EventDate$ = ZeroFill$(EventDate$)   'Zero Fill Event Date
  1957.         END IF
  1958.         GOSUB SpecialMonthly   'Get The Month-End Limits For Special Monthly
  1959.       ELSE
  1960.         DO                     '  Not Special Monthlies
  1961.             CALL KeyStuff(KeyStatus)
  1962.             '---------------------------------------------------------------
  1963.             '   Is the Given Date In the Future?
  1964.             IF EventDate$ > TodaysDate$ THEN
  1965.                 EXIT DO                       '  Future Date
  1966.               ELSE
  1967.                 EventDate$ = TodaysDate$      '  No Earlier Dates
  1968.             END IF
  1969.             '---------------------------------------------------------------
  1970.             '   Has the Time Past?
  1971.             IF EventTime$ > MID$(CurrentTime$, N1, N4) THEN
  1972.                 EXIT DO
  1973.               ELSE
  1974.                 MultiweekCount = VAL(EventRepeatType$)'Multiweek Counter
  1975.             END IF
  1976.             '   Set the Multiweek Counter For Rescheduling
  1977. MultiWeekCounter:
  1978.             IF InString("MQY", EventRepeatType$) = N0 THEN   'Bump Date
  1979.                 CALL IncrementDate(EventDate$)          ' unless Monthly/
  1980.             END IF                                       ' Quarterly/Yearly
  1981.             IF InString("MNQY", EventRepeatType$) THEN
  1982.                 EXIT DO                                 ' Then Logic Below
  1983.             END IF
  1984.         LOOP                                              ' Will Handle
  1985.     END IF
  1986.     '           Now/Older, Increment/Re-Store
  1987.     '-------------------------------------------------------------------------
  1988.     '   Daily, Monthly, Quarter/Yearly (and Special), Bi/Multi-weekly, Weekly
  1989.     SELECT CASE InString("BDWMN123456789QY", EventRepeatType$)
  1990.         CASE 1, 3, N5 TO N14            ' Any repeat on a day of the week
  1991.             ' Weekend Scheduling Not Allowed or
  1992.             '  Weekly or Biweekly or Special Monthly
  1993. DailyOnWeekend:
  1994.             CALL DayDate(EventDate$)
  1995.             DayofWeek = IndexedDay
  1996.             IF EventRepeatType$ = "D" THEN
  1997.                 '  Daily, Disallow Saturday And Sunday
  1998.                 IF DayofWeek = N7 OR DayofWeek = N1 THEN 
  1999.                     GOTO MultiWeekCounter
  2000.                 END IF
  2001.                 GOTO ExitPoint4
  2002.             END IF
  2003.             '---------------------------------------------------------------
  2004.             '   Bi/MultiWeekly or Weekly or Special Monthly (BWN),
  2005.             '    Check the Day
  2006.             IF DayofWeek <> VAL(MID$(EventRepeat$, N2, N1)) THEN
  2007.                 GOTO MultiWeekCounter
  2008.             END IF
  2009.             ' Day of Week is Equal to Day Desired
  2010.             '   If BiWeekly Event Is Being Rescheduled,
  2011.             '    Skip the First Equality
  2012.             '         and Stop on The Second, Else Accept First Good Check
  2013.             '   If Special Monthly, Make Sure Month Hasn't Run Off The End
  2014.             '         (Not Always 5th week's day available)
  2015.             IF EventRepeatType$ <> "N" THEN
  2016.                 IF NOT Rescheduling OR _
  2017.                    InString("B23456789", EventRepeatType$) = N0 THEN 
  2018.                     GOTO ExitPoint4
  2019.                 END IF
  2020.                 '  Multi-Weekly --  Decrease Multiweek Counter
  2021.                 MultiweekCount = MultiweekCount - N1
  2022.                 '   Reset Flag to Stop on Last Week Match --
  2023.                 '    Either Numeric or Biweekly
  2024.                 IF MultiweekCount < N2 THEN Rescheduling = No
  2025.                 GOTO MultiWeekCounter
  2026.             END IF
  2027.             '---------------------------------------------------------------
  2028.             '   Special Monthly -- Specific Week and Day of the Month
  2029.             '   Now Count 7 More Days For Each Week Remaining, If Any
  2030.             ThisDay = VAL(MID$(EventDate$, N7, N2))
  2031.             AddDays = N7 * (SpecMonthlyCount - N1)
  2032.             EndDay = ThisDay + AddDays
  2033.             IF EndDay > TestDay THEN EndDay = EndDay - N7
  2034.             CALL Myd2(EventDate$, N7, N2, (RIGHT$(STR$(EndDay), N2)))
  2035.             EventDate$ = ZeroFill$(EventDate$)   ' Zero Fill Event Date
  2036.             '---------------------------------------------------------------
  2037.             '   Now Check The Result,
  2038.             '    If Earlier Than Now, Pretend to Reschedule for
  2039.             '   Next Month To Increment The Month And Do It All Again
  2040.             IF EventDate$ < TodaysDate$ OR _
  2041.               (EventDate$ = TodaysDate$ AND _
  2042.                EventTime$ <= MID$(CurrentTime$, N1, N4)) THEN
  2043.                 Rescheduling = Yes
  2044.                 GOTO MonthStart
  2045.             END IF
  2046.             '  Result Is Good And Now or Later -- Exit
  2047.         CASE 2                        ' "D"aily
  2048.             '   On Daily Events, Check if Weekend Scheduling Allowed
  2049.             IF WeekendScheduling$ = False$ THEN GOTO DailyOnWeekend
  2050.         CASE N4, N15, N16 ' "M"onthly, "Q"uarterly, "Y"early on specific day
  2051.             '   Monthly, Check the Day or "L"ast
  2052.             DO
  2053.                 CALL KeyStuff(KeyStatus)
  2054.                 GOSUB SpecialMonthly
  2055.                 '           Limit to Last Day
  2056.                 '   Put Resulting Day Back in Date For
  2057.                 '    Display and Scheduling
  2058.                 EventDay$ = ZeroFill$(RIGHT$(STR$(TestDay), N2))
  2059.                 CALL Myd2(EventDate$, N7, N2, EventDay$)
  2060.                 IF EventDate$ > TodaysDate$ OR _
  2061.                   (EventDate$ = TodaysDate$ AND _
  2062.                    EventTime$ > MID$(CurrentTime$, N1, N4)) THEN
  2063.                     GOTO ExitPoint4
  2064.                 END IF
  2065.                 '   Generated Monthly/Quarterly/Yearly Date Is Too Old,
  2066.                 '    Increment Month/Quarter/Year and Try Again
  2067.                 SELECT CASE EventRepeatType$
  2068.                     CASE "M"
  2069.                         TestMonth = TestMonth + N1
  2070.                     CASE "Q"
  2071.                         TestMonth = TestMonth + N3
  2072.                     CASE "Y"
  2073.                         TestYear = TestYear + N1
  2074.                 END SELECT
  2075.                 IF TestMonth > N12 THEN
  2076.                     TestMonth = TestMonth MOD N12
  2077.                     TestYear = TestYear + N1
  2078.                 END IF
  2079.                 CALL Myd2(EventDate$, N5, N2, _
  2080.                     (RIGHT$(STR$(TestMonth), N2)))
  2081.                 CALL YearAdjust(TestYear, AdjustedYear$)
  2082.                 CALL Myd2(EventDate$, N1, N4, AdjustedYear$)
  2083.                 EventDate$ = ZeroFill$(EventDate$) ' Zero Fill Event Date
  2084.             LOOP
  2085.     END SELECT
  2086.     GOTO ExitPoint4
  2087.     '-------------------------------------------------------------------------
  2088. SpecialMonthly:
  2089.     TestYear = VAL(MID$(EventDate$, N1, N4))
  2090.     TestMonth = VAL(MID$(EventDate$, N5, N2))
  2091.     '   Last or Actual Method? Or Special Monthly to Set TestDay
  2092.     IF MID$(EventRepeat$, N2, N1) = "L" OR EventRepeatType$ = "N" THEN
  2093.         '   Last Day Method
  2094. LastDayMethod:
  2095.         IF TestMonth = N2 THEN
  2096.             IF Leap(TestYear) THEN 
  2097.                 TestDay = N29 
  2098.               ELSE 
  2099.                 TestDay = N28
  2100.             END IF
  2101.           ELSE
  2102.             TestDay = MonthLength(TestMonth)
  2103.         END IF
  2104.         RETURN
  2105.       ELSE
  2106.         '  Actual Day Method
  2107.         TestDay = VAL(MID$(EventRepeat$, N2, N2))
  2108.         IF TestDay <= MonthLength(TestMonth) THEN RETURN
  2109.         '  Too Large
  2110.         GOTO LastDayMethod
  2111.     END IF
  2112.     '-------------------------------------------------------------------------
  2113.     '   Error Return
  2114. ErrorReturn:
  2115.     EventValidationError = N1
  2116.     '-------------------------------------------------------------------------
  2117. ExitPoint4:
  2118.         Subnum = SubnumSave
  2119.     END SUB
  2120.     '=========================================================================
  2121.     SUB VideoMonitorType  STATIC
  2122.     '=========================================================================
  2123.     DEFINT A-Z
  2124.         SubnumSave = Subnum
  2125.         Subnum = 90
  2126.     '  See whether monitor is mono or color
  2127.     CALL MhDisplay (DispMode%, DispColumns%, DispRows%, Memory%, _
  2128.         DisplayType%)
  2129.     IF DisplayType < 128 OR (NOT MemoryResident AND _
  2130.                         COMMAND$ = "COLOR2MON") THEN
  2131.         MonoCRT = Yes
  2132.         ColorCRT = No
  2133.         CalMode = N7
  2134.       ELSE                        ' Mono simulation unless resident
  2135.         ColorCRT = Yes
  2136.         MonoCRT = No
  2137.         CalMode = N3
  2138.     END IF
  2139.         Subnum = SubnumSave
  2140.     END SUB                       '  (may be false if we never go resident)
  2141.     '=========================================================================
  2142.     SUB WindowInit STATIC
  2143.     '=========================================================================
  2144.     DEFINT A-Z
  2145.         SubnumSave = Subnum
  2146.         Subnum = 91
  2147.     ' Initialize Window Manager for Cal & User screens save & restore
  2148.     WindDtaseg = VARSEG(WindowBuffer(N1))'(1 4000-byte bufs+ 8 ctl bytes)
  2149.     CALL MhWind(N0%, WindDtaseg%, N0%, ScreenPage%, N1%, _
  2150.         N1%, N25%, N80%, N1%, 4008%, Ecode%)
  2151.     IF Ecode THEN ERROR 255
  2152.     WindowInitted = Yes
  2153.         Subnum = SubnumSave
  2154.     END SUB
  2155.     '=========================================================================
  2156.     SUB WindowRestore   STATIC
  2157.     '=========================================================================
  2158.     DEFINT A-Z
  2159.         SubnumSave = Subnum
  2160.         Subnum = 92
  2161.     WindDtaseg = VARSEG(WindowBuffer(N1))    ' Restore User/Calendar Screen
  2162.     CALL MhWind(N0%, WindDtaseg%, N2%, ScreenPage%, N1%, _
  2163.         N1%, N25%, N80%, N1%, N0%, Ecode%)
  2164.     IF Ecode THEN ERROR 255
  2165.         Subnum = SubnumSave
  2166.     END SUB
  2167.     '=========================================================================
  2168.     SUB WindowSave   STATIC
  2169.     '=========================================================================
  2170.     DEFINT A-Z
  2171.         SubnumSave = Subnum
  2172.         Subnum = 93
  2173.     IF NOT WindowInitted THEN CALL WindowInit    ' Initialize Window Manager
  2174.     WindowError = No                             ' Save User/Calendar Screen
  2175.     DO
  2176.         WindDtaseg = VARSEG(WindowBuffer(N1%))
  2177.         CALL MhWind(N0%, WindDtaseg%, N1%, ScreenPage%, _
  2178.             N1%, N1%, N25%, N80%, N1%, N0%, Ecode%)
  2179.         IF Ecode = N0 OR (WindowError AND Ecode <> N0) THEN EXIT DO
  2180.         IF Ecode = N5 THEN             ' Shrink buffer one screen, one try
  2181.             WindDtaseg = VARSEG(WindowBuffer(N1%))
  2182.             CALL MhWind(N0%, WindDtaseg%, N3%, 4000%, _
  2183.                 N1%, N1%, N25%, N80%, N1%, N0%, Ecode%)
  2184.             IF Ecode THEN EXIT DO ELSE WindowError = Yes ' (shrunk)
  2185.         END IF
  2186.     LOOP WHILE WindowError
  2187.     IF Ecode THEN ERROR 255
  2188.         Subnum = SubnumSave
  2189.     END SUB
  2190.     '=========================================================================
  2191.     SUB WriteCalauto STATIC
  2192.     '=========================================================================
  2193.     DEFINT A-Z
  2194.         SubnumSave = Subnum
  2195.         Subnum = 94
  2196.     CLOSE FilenumAuto
  2197.     OPEN "O", FilenumAuto, "calauto.dat"
  2198.     WriteAppt$ = ApptFilename$
  2199.     WritePass$ = ApptPassword$
  2200.     IF AutostartMode THEN
  2201.         AutoMode$ = True$
  2202.       ELSE
  2203.         AutoMode$ = False$
  2204.         WriteAppt$ = Blank8$
  2205.         WritePass$ = Blank8$
  2206.     END IF
  2207.     WRITE #FilenumAuto, WriteAppt$, WritePass$, AutoMode$, ForceDate
  2208.     CLOSE FilenumAuto
  2209.         Subnum = SubnumSave
  2210.     END SUB
  2211.     '=========================================================================
  2212.     SUB WriteCalDOS STATIC
  2213.     '=========================================================================
  2214.     DEFINT A-Z
  2215.         SubnumSave = Subnum
  2216.         Subnum = 95
  2217.     CLOSE FilenumDOS
  2218.     OPEN "O", FilenumDOS, "caldos.dat"
  2219.     WRITE #FilenumDOS, DOSCommand$
  2220.     CLOSE FilenumDOS
  2221.         Subnum = SubnumSave
  2222.     END SUB
  2223.     '=========================================================================
  2224.     SUB WriteCalexcl STATIC
  2225.     '=========================================================================
  2226.     '   Write Exclusion File
  2227.     DEFINT A-Z
  2228.         SubnumSave = Subnum
  2229.         Subnum = 96
  2230.     CLOSE FilenumExcl
  2231.     OPEN "O", FilenumExcl, "calexcl.dat"
  2232.     FOR J = N1 TO N2
  2233.         WRITE #FilenumExcl, ExcludefromHistory$(J)
  2234.     NEXT J
  2235.     CLOSE FilenumExcl
  2236.         Subnum = SubnumSave
  2237.     END SUB
  2238.     '=========================================================================
  2239.     SUB WriteCalfig STATIC
  2240.     '=========================================================================
  2241.     DEFINT A-Z
  2242.         SubnumSave = Subnum
  2243.         Subnum = 97
  2244.     CLOSE FilenumFig
  2245.     OPEN "O", FilenumFig, "calfig.dat"
  2246.     WRITE #FilenumFig, Chf, Chb, Cl1f, Cl1b, Cl2f, Cl2b, Cl3f, _
  2247.                     Cl3b, Cl4f, Cl4b, Cl5f, Cl5b, Cl6f, Cl6b
  2248.     CLOSE FilenumFig
  2249.         Subnum = SubnumSave
  2250.     END SUB
  2251.     '=========================================================================
  2252.     SUB WriteCalmusic STATIC
  2253.     '=========================================================================
  2254.     '   Write Entry
  2255.     DEFINT A-Z
  2256.         SubnumSave = Subnum
  2257.         Subnum = 98
  2258.     CLOSE FilenumMusic
  2259.     OPEN "O", FilenumMusic, "calmusic.dat"
  2260.     WRITE #FilenumMusic, Alarm$, Chime$, Warning$
  2261.     CLOSE FilenumMusic
  2262.         Subnum = SubnumSave
  2263.     END SUB
  2264.     '=========================================================================
  2265.     SUB WriteCalres STATIC
  2266.     '=========================================================================
  2267.     DEFINT A-Z
  2268.         SubnumSave = Subnum
  2269.         Subnum =  99
  2270.     CLOSE FilenumRes
  2271.     OPEN "O", FilenumRes, "calres.dat"
  2272.     ' Initials aren't used in SRP 4, hence dummy "CL"
  2273.     WRITE #FilenumRes, EverResident$, UserPopDateTime$, UseDiskSwap$, _
  2274.       UseEMS$, SrSwapPath$, "CL", SrKscanHot, SrKshiftHot, _
  2275.       SrAutoPopDown, SrSnowCheck, SrPopupOnlyIfScreenSaved
  2276.     CLOSE FilenumRes
  2277.         Subnum = SubnumSave
  2278.     END SUB
  2279.     '=========================================================================
  2280.     SUB WritetoHistory STATIC
  2281.     '=========================================================================
  2282.     DEFINT A-Z
  2283.         SubnumSave = Subnum
  2284.         Subnum = 100
  2285.     '   If a note, write directly, else check for exclusion
  2286.     IF EventtoHistory THEN
  2287.         '   If recording event, exclude refrain text
  2288.         FOR J = N1 TO N2
  2289.             IF ExcludefromHistory$(J) = MID$(HistoryBuffer$, N28, TextSize) _
  2290.                OR SPACE$(TextSize) = MID$(HistoryBuffer$, N28, TextSize) THEN
  2291.                 GOTO ExitPoint5
  2292.             END IF
  2293.         NEXT J
  2294.     END IF
  2295.     '   Write to History if Not Blank
  2296.     IF HistoryBuffer$ <> Blank80$ THEN
  2297.         CALL MhLset(ApptBuffer$, HistoryBuffer$)
  2298.         Pointer = N1 + LOF(FilenumAppt) \ N80
  2299.         CALL PutApptRecord(Pointer)
  2300.     END IF
  2301. ExitPoint5:
  2302.         Subnum = SubnumSave
  2303.     END SUB
  2304.     '=========================================================================
  2305.     SUB YearAdjust (YeartoAdjust, AdjustedYear$) STATIC
  2306.     '=========================================================================
  2307.     '  Given a Numeric Year, Right-Adjust It In A String Of 4 Length
  2308.     '    Input is YeartoAdjust--numeric, Output is AdjustedYear$--String
  2309.     DEFINT A-Z
  2310.         SubnumSave = Subnum
  2311.         Subnum = 101
  2312.     AdjustedYear$ = SPACE$(N4)
  2313.     RawYear$ = STR$(YeartoAdjust)
  2314.     YearLength = LEN(RawYear$) - N1
  2315.     RawYear$ = RIGHT$(RawYear$, YearLength)
  2316.     CALL Myd2(AdjustedYear$, N5 - YearLength, YearLength, RawYear$)
  2317.         Subnum = SubnumSave
  2318.     END SUB
  2319.     '=========================================================================
  2320.     FUNCTION ZeroFill$ (ToZeroFill$) STATIC
  2321.     '=========================================================================
  2322.     DEFINT A-Z
  2323.         SubnumSave = Subnum
  2324.         Subnum = 102
  2325.     FillDummy$ = ToZeroFill$
  2326.     DO
  2327.         J = InString(FillDummy$, Blank1$)
  2328.         IF J THEN
  2329.             CALL Myd2(FillDummy$, J, N1, Zeroo$)
  2330.           ELSE
  2331.             EXIT DO
  2332.         END IF
  2333.     LOOP
  2334.     ZeroFill$ = FillDummy$
  2335.         Subnum = SubnumSave
  2336.     END FUNCTION
  2337.     '========================================================================
  2338.     '========================  END OF CAL6.BAS  =============================
  2339.     '========================================================================
  2340.